I have a master_macro that calls 2 other macros: (sub)calc and (sub)transfer. The calc macro doesn't need any variables passed to it, but the other one does and when the master_macro calls the transfer macro, there are several passed variables that are being modified even though they are passed using the byval method. these declarations are nested in a for loop because they are workbook names.
dpath = ws.cells(2,9).value
fname = ws.cells(i,10).value
set wkbk = workbooks.open(dpath & fname & ".xlsx")
call calc
tempname = ws.cells(4,9).value
fpath = ws.cells(3,9).value
temppath = ws.cells(5,9).value
set wkbk2 = workbooks.open(temppath & tempname) 'the tempname should have the extension
call transfer(fname, dpath, fpath, tempname, wkbk, wkbk2)
Here is how I start the transfer subroutine.
sub transfer(byval fname, byval dpath, byval fpath, byval tempname, byval wkbk, byval wkbk2)
I have breakpoints at the call point to step through it, to see what the variables are. Somehow the fpath and the tempname varialbes get switched. I was under the impression that if use byval they can't be changed. I noticed the error when once the transfer ran and broke at the 'next i' in the loop, it didn't save the tempname in the fpath folder.
Related
Let's say I have a function that takes a value of a cell from one of the sheets and makes a copy of that file under that name in the specified directory:
Function SavePeerGroupAsFile(source_file, peer_group, file_path)
SavePeerGroupAsFile = source_file.SaveCopyAs(filename:=file_path & peer_group & ".xlsm")
End Function
I would like to be able to use it in my Main so that after the function is called, that workbook is set as a variable, so I could directly work on it and do some other stuff. To call it, in my Main, I'm using:
Set peer_wrk = SavePeerGroupAsFile(src_wrk, peer_group_name, peer_group_dir)
I can see the file saved under correct name in the right directory but right after function is called it throws an error:
Any idea how this should be done correctly?
You need to open the copied workbook:
Function SavePeerGroupAsFile( _
ByVal source_file As Workbook, _
ByVal peer_group As String, _
ByVal file_path As String _
) As Workbook
source_file.SaveCopyAs Filename:=file_path & peer_group & ".xlsm"
Set SavePeerGroupAsFile = Workbooks.Open(file_path & peer_group & ".xlsm")
End Function
The problem has been narrowed down to one line. It is an issue between absolute and relative path.
This line works:
PlayWavFile "c:\TransmissionFile\AWNP.wav", False
I prefer something like this but it does not work:
PlayWavFile "AWNP.wav", False
I have the wave file in both the C drive and in the same folder as the program. So for the program folder to be portable, I would like to use the relative path. How do I do that? What is wrong?
Try this:
Dim CurrentFolder As String
CurrentFolder = ThisWorkbook.Path
PlayWavFile CurrentFolder & Application.PathSeparator & "AWNP.wav", False
Your question leaves a few open questions. However, taking a best guess approach, I think this is what you're aiming to do:
Option Explicit
' assuming this is the Lib declaration:
Public Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
' and assuming this is the sub format you're using to call (as declared) sndPlaySound
Sub PlayWavFile(WavFileName As String, Wait As Boolean)
' Set path based on this workbook's folder location
Dim stFilePath$: stFilePath = ThisWorkbook.Path & "\" & WavFileName
' If file is missing, try root of C drive
If Dir(stFilePath) = "" Then
stFilePath = "C:\" & WavFileName
' Not here either: report and end
If Dir(stFilePath) = "" Then
MsgBox WavFileName & " not found"
Exit Sub
End If
End If
' Play the sound (with/without wait)
If Wait Then
sndPlaySound stFilePath, 0
Else
sndPlaySound stFilePath, 1
End If
End Sub
I have a macro that compiles rows within tables across multiple files. All files are essentially copies of the "master" file. Each file is used by a different person.
The rows to copy are on "Table_Data" in "Tracker" sheet, with these names being stored in constant variables.
The macro first checks if the pre-defined list of individual files exist in the same folder and are not open.
Once that check is passed, the files are opened one by one, with all data in the table read into an array.
That array is looped through to copy rows, that fit certain requirements, into a compiled array.
Once that is done, the array is emptied, file #1 is closed and file #2 is opened to repeat the above step.
Once all required rows have been copied into the compiled array, the array is pasted in the master file.
As part of error checking, I want to check if the pre-defined list of files have the correct sheetname and the correct table name inside that sheet, BEFORE opening the file. If one of the files is not valid, I don't want the compiler to start.
I found snippets of code, but I haven't been able to make any of them give me a True/False on whether or not the sheet and table exist on the file while the file is closed.
Checking If A Sheet Exists In An External Closed Workbook
Excel VBA - Get name of table based on cell address
I have this, however, the file has to be opened, which slows down the macro.
To save time, I call it before copying the rows from each file and if the file is not valid, do not compile and show message stating which files are not valid.
Option Explicit
Function IsFileValid(ByVal strFileName As String) As Boolean
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & strFileName, True, True)
On Error Resume Next
If Worksheets(wrkshtTracker).ListObjects(tableTracker).Range(1, 2) = strEmailHeader Then
IsFileValid = True
End If
wb.Close False
Set wb = Nothing
On Error GoTo 0
Application.ScreenUpdating = True
End Function
I want this check before opening the files.
Let's say our excel file looks like this
Logic:
Copy the excel file to user temp directory and rename it to say "Test.Zip"
Unzip the Zip files
We will keep our attention to 2 different folders. \xl\worksheets and \xl\tables. This is where the xml files are created.
\xl\worksheets If a sheet exists then an xml will be created with that name as shown below.
\xl\tables If a table exists then an xml will be created as shown below. However in this case, it is not necessary that the name of the table will be the same as the file name. However the name of the table will be inside the xml file as shown below
and this is the content of the 2nd xml file.
So simply check if the xml file exists for the sheet and for the table, check the contents of the file.
Code:
Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim zipFilePath As Variant
Dim tmpDir As Variant
Dim filePath As String
Dim oApp As Object
Dim StrFile As String
Sub Sample()
filePath = "C:\Users\routs\Desktop\sid.xlsx"
tmpDir = TempPath & Format(Now, "ddmmyyhhmmss")
zipFilePath = tmpDir & "\Test.Zip"
MsgBox DoesSheetExist("Sheet1")
MsgBox DoesTableExist("Table13")
End Sub
'~~> Function to check if a sheet exists
Private Function DoesSheetExist(wsName As String) As Boolean
MkDir tmpDir
FileCopy filePath, zipFilePath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(tmpDir & "\").CopyHere oApp.Namespace(zipFilePath).items
If Dir(tmpDir & "\xl\worksheets", vbDirectory) <> "" Then
StrFile = Dir(tmpDir & "\xl\worksheets\*.xml")
Do While Len(StrFile) > 0
If UCase(Left(StrFile, (InStrRev(StrFile, ".", -1, vbTextCompare) - 1))) = UCase(wsName) Then
DoesSheetExist = True
Exit Do
End If
StrFile = Dir
Loop
End If
If Len(Dir(tmpDir, vbDirectory)) <> 0 Then
CreateObject("Scripting.FileSystemObject").DeleteFolder tmpDir
End If
End Function
'~~> Function to check if a table exists
Private Function DoesTableExist(tblName As String) As Boolean
Dim MyData As String, strData() As String
Dim stringToSearch As String
stringToSearch = "name=" & Chr(34) & tblName & Chr(34)
MkDir tmpDir
FileCopy filePath, zipFilePath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(tmpDir & "\").CopyHere oApp.Namespace(zipFilePath).items
If Dir(tmpDir & "\xl\tables", vbDirectory) <> "" Then
StrFile = Dir(tmpDir & "\xl\tables\*.xml")
Do While Len(StrFile) > 0
Open tmpDir & "\xl\tables\" & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
If InStr(1, MyData, stringToSearch, vbTextCompare) Then
DoesTableExist = True
Exit Do
End If
StrFile = Dir
Loop
End If
If Len(Dir(tmpDir, vbDirectory)) <> 0 Then
CreateObject("Scripting.FileSystemObject").DeleteFolder tmpDir
End If
End Function
'~~> Function to get user temp directory
Private Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
I have been doing checks with worksbooks for things like if the sheet exists or what is in a cell without opening the workbook using this command
f = "'" & strFilePath1 & "[" & strFileType & "]" & strSheetName & "'!" & Range(strCell).Address(True, True, -4150)
CheckCell = Application.ExecuteExcel4Macro(f)
and it has been working well but now i am wanting to check if the sheet is Password protected without opening but haven't been successful. Anyone know if this is possible?
Thanks for help in advance
Yes! It is possible. I discovered how to do it long time ago. I doubt this is mentioned anywhere in the web...
Basic Introduction: As you are aware, Microsoft Excel up until 2007 version used a proprietary binary file format called Excel Binary File Format (.XLS) as its primary format. Excel 2007 onwards uses Office Open XML as its primary file format, an XML-based format that followed after a previous XML-based format called "XML Spreadsheet" ("XMLSS"), first introduced in Excel 2002.
Logic: To understand how this works, do the following
Create a new Excel file
Ensure it has at least 3 sheets
Protect the 1st sheet with a blank password
Leave the 2nd sheet unprotected
Protect the 3rd sheet using any password
Save the file, say, as Book1.xlsx and close the file
Rename the file to, say, Book1.Zip
Extract the contents of the zip
Go to the folder \xl\worksheets
You will see that all the sheets from the workbook has been saved as Sheet1.xml,Sheet2.xml and Sheet3.xml
Right click on the sheets and open it in notepad/notepad++
You will notice that all the sheets you protected has one word <sheetProtection as shown below
So if we can somehow check if the relevant sheet has that word then we can ascertain whether the sheet is protected or not.
Code:
Here is a function which can help you in what you want to achieve
'~~> API to get the user temp path
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Sub Sample()
'~~> Change as applicable
MsgBox IsSheetProtected("Sheet2", "C:\Users\routs\Desktop\Book1.xlsx")
End Sub
Private Function IsSheetProtected(sheetToCheck As Variant, FileTocheck As Variant) As Boolean
'~~> Temp Zip file name
Dim tmpFile As Variant
tmpFile = TempPath & "DeleteMeLater.zip"
'~~> Copy the excel file to temp directory and rename it to .zip
FileCopy FileTocheck, tmpFile
'~~> Create a temp directory
Dim tmpFolder As Variant
tmpFolder = TempPath & "DeleteMeLater"
'~~> Folder inside temp directory which needs to be checked
Dim SheetsFolder As String
SheetsFolder = tmpFolder & "\xl\worksheets\"
'~~> Create the temp folder
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(tmpFolder) = False Then
MkDir tmpFolder
End If
'~~> Extract zip file in that temp folder
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(tmpFolder).CopyHere oApp.Namespace(tmpFile).items
'~~> Loop through that folder to work with the relevant sheet (file)
Dim StrFile As String
StrFile = Dir(SheetsFolder & sheetToCheck & ".xml")
Dim MyData As String, strData() As String
Dim i As Long
Do While Len(StrFile) > 0
'~~> Read the xml file in 1 go
Open SheetsFolder & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
For i = LBound(strData) To UBound(strData)
'~~> Check if the file has the text "<sheetProtection"
If InStr(1, strData(i), "<sheetProtection", vbTextCompare) Then
IsSheetProtected = True
Exit For
End If
Next i
StrFile = Dir
Loop
'~~> Delete temp file
On Error Resume Next
Kill tmpFile
On Error GoTo 0
'~~> Delete temp folder.
FSO.deletefolder tmpFolder
End Function
'~~> Get User temp directory
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
Note: This has been tested for .xlsx and .xlsm files.
I have a folder with 30 or so .gz zipped files and 1 .zip files. I can ue code to utilise Windows Explorer to unzip the 1 .zip file, but unfortunately, Windows explorer does not unzip .gz files. I have created code which utilises Winzip to open all these files, but unfortunately this opens up the path folder, every time it unzips, I end up with 30+ open folders, which I then close, one by one with further code - unnecessary. A process that takes near 10 minutes.
Scouring the net, I've found and adapted a Ron De Bruin code that utilises '7-zip' software , open source and freely available online, to unzip without opening up a new folder each time. It unzips all files effortlessly in about a minute, far better. The code is below (mainly comments so not as long as it first looks!). My only problem is that sometimes this unzips files, and sometimes this runs without unzipping any files. When it runs perfectly, it toggles the 'GetExitCodePorcess hProcess, ExitCode' line longer, there I'm assuming it is processes to get an ExitCode which allows it to unzip the file. When it isn't working, it only toggles once or twice and moves onto the next stage, therefore, I assume that it generated the wrong exit code.
Is the problem the PtrSafe Function? Or is it in my ShellStr, or anywhere else? Please help, as I want to avoid using the Winzip method. If anyone has any other alternatives, please suggest!
#If VBA7 Then
Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
#Else
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
#End If
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103
Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub
'With this example you unzip a fixed zip file: FileNameZip = "C:\Users\Ron\Test.zip"
'Note this file must exist, this is the only thing that you must change before you test it
'The zip file will be unzipped in a new folder in: Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'The name of the folder that the code create in this folder is the Date/Time
'You can change this folder to this if you want to use a fixed folder:
'NameUnZipFolder = "C:\Users\Ron\TestFolder\"
'Read the comments in the code about the commands/Switches in the ShellStr
Public Sub B_UnZip_Zip_File_Fixed()
Dim PathZipProgram As String, FolderPath As String
Dim UnzipFile As Variant, ShellStr As String
FolderPath = _
ThisWorkbook.Path
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Path of the Zip program
PathZipProgram = "C:\program files\7-Zip\"
If Right(PathZipProgram, 1) <> "\" Then
PathZipProgram = PathZipProgram & "\"
End If
'Check if this is the path where 7z is installed.
If Dir(PathZipProgram & "7z.exe") = "" Then
MsgBox "Please find your copy of 7z.exe and try again"
Exit Sub
End If
UnzipFile = _
Dir(FolderPath & "*.gz")
While UnzipFile <> _
""
If InStr(1, UnzipFile, ".gz") > _
0 Then
ShellStr = PathZipProgram & "7z.exe e -aoa -r" _
& " " & Chr(34) & UnzipFile & Chr(34) _
& " -o" & Chr(34) & FolderPath & Chr(34) & " " & "*.*"
ShellAndWait ShellStr, vbHide
End If
UnzipFile = _
Dir
Wend
'Create path and name of the normal folder to unzip the files in
'In this example we use: Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'The name of the folder that the code create in this folder is the Date/Time
'NameUnZipFolder = Application.DefaultFilePath & "\" & Format(Now, "yyyy-mm-dd h-mm-ss")
'You can also use a fixed path like
'NameUnZipFolder = "C:\Users\Ron\TestFolder\"
'Name of the zip file that you want to unzip (.zip or .7z files)
'FileNameZip = "C:\Users\Ron\Test.zip"
'There are a few commands/Switches that you can change in the ShellStr
'We use x command now to keep the folder stucture, replace it with e if you want only the files
'-aoa Overwrite All existing files without prompt.
'-aos Skip extracting of existing files.
'-aou aUto rename extracting file (for example, name.txt will be renamed to name_1.txt).
'-aot auto rename existing file (for example, name.txt will be renamed to name_1.txt).
'Use -r if you also want to unzip the subfolders from the zip file
'You can add -ppassword if you want to unzip a zip file with password (only .7z files)
'Change "*.*" to for example "*.txt" if you only want to unzip the txt files
'Use "*.xl*" for all Excel files: xls, xlsx, xlsm, xlsb
'MsgBox "Look in " & NameUnZipFolder & " for extracted files"
End Sub
No, the exit code tells you the result of the external process that you spawned. For Windows 0 indicates success, non-zero indicates failure (or something else that meant the process wasn't successful)
So basically for some of .gz files 7zip can't complete successfully. You as the coder need to deal with this likely eventuality.
So your best bet is to print/log the 7zip command that it ran ShellStr and run that yourself manually in a command prompt/dos window to see the reason why.