having some issues with using VBA to create a zip of a file. When I run the file I get the below error:
Object variable or With block variable not set.
Which is triggered when execution reaches this line:
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items.
I'm not very familiar with VBA but the MS docs suggested Option Strict On at the top of the file. When I add this however I just get another error:
Expected: Base or Compare pr Explicit or Private.
Any idea what is going on here?
Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant)
Dim ShellApp As Object
'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items
'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End Sub
Call CreateZipFile("C:\users\someuser\desktop\test", "C:\users\someuser\desktop\test.zip")
To anyone else who has this issue. It turned out to be related to empty folders. If the folder below was empty, an exception was triggered.
ShellApp.Namespace(folderToZipPath).items
Related
It is easy to find in the internet a way of write into a txt file but all I find is always writing in the very last line:
Sub write_log(sentence_to_be_written As String)
Dim strFile_Path As String
strFile_Path = "C:\Users\[user_name]\Desktop\log.txt"
Open strFile_Path For Append As #1
Print #1, Now() & " --> " & sentence_to_be_written
Close #1
End Sub
I would like to write instead into the first line of the txt file.
Try the next code, please. It needs a reference to Microsoft Scripting Runtime. It can be adapted to work without such a reference. In fact, I will also post a pice of code able to automatically add the necessary reference... It is possible to read the text using standard VBA Open, but only concatenating line by line and I think this solution is more elegant:
Sub write_log_OnTop(sentence_to_be_written As String)
'It neds a reference to 'Microsoft Script Runtime'
Dim strFile_Path As String, strText As String
Dim fso As New FileSystemObject, txtStr As TextStream
strFile_Path = "C:\Users\Fane Branesti\OneDrive\Desktop\log.txt"
If Dir(strFile_Path) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(strFile_Path)
strText = txtStr.ReadAll
txtStr.Close
Else
MsgBox "Wrong file path...": Exit Sub
End If
strText = Now() & " --> " & sentence_to_be_written & vbCrLf & strText
Open strFile_Path For Output As #1
Print #1, strText
Close #1
End Sub
And Microsoft Scripting Runtime reference can be automatically add by running of the next code:
Private Sub Add_Scripting_Reference() 'Adds 'Microsoft Scripting Runtime'
Dim wb As Workbook, r As Reference
Set wb = ThisWorkbook
For Each r In wb.VBProject.References
If r.name = "Scripting" Then Exit Sub
Next
wb.VBProject.References.AddFromFile Environ("windir") & "\system32\scrrun.dll"
End Sub
If you do not want the reference, even if I would not understand such a choice, it is enough to comment/replace the code line
Dim fso As New FileSystemObject, txtStr As TextStream
with:
Dim fso As Object, txtStr As Object: Set fso = CreateObject("Scripting.FileSystemObject")
There is no command to add text at the top (or the middle) of any file. I never heard about such command in any programming language. It's about (disk-)space management, if you add a line of text in front of any other text, the existing text needs to be moved, and this is a rather complicated operation.
If you deal with short files, you could solve that by reading the content of the file into memory and then recreate the file by first writing the new line(s) and the add the content - as Joerg Wood suggested in the comments. However, this would need lot of memory and/or disk IO if the file gets larger, and the process has to be repeated every time you want to add a line - maybe not an issue if you write only one line per hour, but quite an issue if you are writing multiple lines per second.
It seems you are writing a log file and probably you want to see what was going on lately. You could use a windows version of the tail command (that comes from Unix) or use the powershell command Get-Content "C:\Users\[user_name]\Desktop\log.txt" -Tail 10 (see https://stackoverflow.com/a/188126/7599798) for that - it will display the last lines of a file.
An alternative could be to write the log into an Excel sheet or a database - in both cases it is easy to fetch the data in any order.
The goal of my effort is to have a VBA macro that will consolidate a number of PPT presentations into a single PPT presentation. The component presentations that are to be combined are in a number of locations. This seems to be a crucial factor. I found a very good 'almost' solution, but it was based on all of the component presentations being in a single folder. I was able to modify the example, but ActivePresentation.Slides.InsertFromFile will only function if the path to a component presentation is hardcoded. I need this to be data-driven. When I try to reference a variable containing the path, ActivePresentation.Slides.InsertFromFile fails with the error "Error inserting files Error: -2147483640 Powerpoint could not open the file".
Any assistance to get this running by passing the component path as a variable would be very appreciated. Thanks, Jack
The contents of the MANIFEST.txt file are the two lines:
topic-1/control-structures.pptm
topic-2/cursors.pptm
Sub InsertExample()
' Inserts all presentations named in MANIFEST.txt into current presentation in list order
' MANIFEST.txt must be properly formatted, one full path name per line
On Error GoTo ErrorHandler
Dim ManifestFileName As String
Dim ManifestFilePathColons As String
Dim ManifestFilePathSlashes As String
Dim iListFileNum As Integer
Dim ManifestPresentationName As String
Dim FullPresentationPath As String
' name of file containing files to be inserted
ManifestFileName = "MANIFEST.txt"
' use the path with colons to work with the MANIFEST.txt file
ManifestFilePathColons = "Macintosh HD:Users:freejak:Google Drive:stirling:course-topics:auto-consolidate:"
' use the path with slashes to work with the ActivePresentation.Slides.InsertFromFile PPT method
ManifestFilePathSlashes = "Macintosh HD/Users/freejak/Google Drive/stirling/course-topics/auto-consolidate/"
' Do we have a file open already?
' Debug.Print Presentations.Count
If Not Presentations.Count > 0 Then
Exit Sub
End If
iListFileNum = FreeFile()
Open ManifestFilePathColons & ManifestFileName For Input As iListFileNum
' Process the list
While Not EOF(iListFileNum)
' Get a line from the list file
Line Input #iListFileNum, ManifestPresentationName
'The following invocation works, and the seperator must be a slash
Call ActivePresentation.Slides.InsertFromFile("Macintosh HD/Users/freejak/Google Drive/stirling/course-topics/auto-consolidate/topic-1/control-structures.pptm", _
ActivePresentation.Slides.Count)
FullPresentationPath = ManifestFilePathSlashes & ManifestPresentationName
'This invocation fails, the same error occurs if I call passing "ManifestFilePathSlashes & ManifestPresentationName" without the quotes
' This fails whether the seperators are colons or slashes
' Call ActivePresentation.Slides.InsertFromFile(FullPresentationPath, ActivePresentation.Slides.Count)
Wend
Close #iListFileNum
MsgBox "DONE!"
NormalExit:
Exit Sub
Not sure if this is relevant but you’ve got an extra “topic1” subfolder when you type the path out, vs the path written into the string variables.
I have excel vba code that opens different files on makes use of them. An error can occur because there is no file where excel loos for it. I want to create a MsgBox on such errors with a message which specific file is absent.
Now I can only
On Error GoTo ErrorHandler
ErrorHandler:
MsgBox("File is absent")
But I can't specify which exactly file is absent. Is there a way to achieve it through error handler? Maybe through some additional variable?
EDIT: I open files through
Workbooks.Open Filename:=...
But I'm curious about what one should do if the case is
Dim fileTitle As String
filetitle=Dir()
as well.
Rather than hard-coding the file path via:
Workbooks.Open Filename:=...
Use a variable to represent the file path/name:
Dim fileName As String
fileName = "C:/path/to/my/file.xlsx"
Then, check to make sure it exists before you attempt to open it:
If FileIsAccessible(fileName) Then
' Do stuff
Else
MsgBox fileName & " doesn't exist or cannot be opened"
Exit Sub
End If
Use a custom function like
Function FileIsAccessible(path$) As Boolean
Dim FF As Long
On Error GoTo EarlyExit
FF = FreeFile
'Does file exist?
' Raises Error 53 if file not found
Open path For Input Access Read As FF
Close FF
'If file exist, is it accessible?
' Raises error 70 if file is locked/in-use
FF = FreeFile
Open path For Binary Access Write As FF
Close FF
EarlyExit:
FileIsAccessible = (Err.Number = 0)
End Function
You still have access to your variables in error handler, so you know within which file error happen:
Sub ...
Dim filename As String
On Error GoTo ErrorHandler
filename = Dir(...)
While filename>""
Set wb = Workbooks.Open(filename)
...
filename=Dir
Wend
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " File: " & filename
End Sub
Two ways to go about this. First, as you suggested, (which is also the easier of the two), you can make a variable that will carry the file name that you reassign after each file successfully loads. That name can then be passed into your message box in the event of a failure. If all you need to do is pass this name, this is the better solution.
The second option would be to create multiple error handlers. I would only recommend this if you need more customization with regard to how the error is handled, like wanting a different message to be displayed based on which type of file was missing. This option would make your code a good bit messier (as you would need to reassign the On Error GoTo ... statement multiple times, but its worth considering if you need a more complex solution.
Give this a try and tweak it as per your requirement. This will give you a starting point to deal with error handling....
Assuming you are trying to open a file abc.xlsx which is located at your Desktop and if this file isn't found on Desktop, the error handling will be triggered.
Don't forget to use Exit Sub before Error Handling label so that it is not executed if the file was found.
Dim wb As Workbook
Dim FilePath As String
FilePath = Environ("UserProfile") & "\Desktop\abc.xlsx"
On Error GoTo ErrorHandler
Set wb = Workbooks.Open(FilePath)
'Other stuff here if file was found and opened successfully
'
'
'
'
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "File Not Found!"
I've written a script to add all files in a folder to a zip file using code adapted from www.rondebruin.nl, but I keep getting an error 'Object variable or With block variable not set'.
Function ZipDir(FolderName As String, ZipName As String) As String
'Copied from: http://www.rondebruin.nl/win/s7/win001.htm
Dim FileNameZip ', FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object
'Create empty Zip File
NewZip ZipName
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(ZipName).CopyHere oApp.Namespace(FolderName).items '<<ERROR HERE
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = _
oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
MsgBox "You find the zipfile here: " & ZipName
End Function
The code errors on the oApp.Namespace(ZipName).CopyHere oApp.Namespace(FolderName).items line. However if I explicitly declare the source and destination files like so: oApp.Namespace("C:\MyZip.Zip").CopyHere "C:\Temp\MyFile.pdf"
If I change Either the zip name, or the file name from above, then it errors.
Any ideas?
When using a Shell.Application object, you should pass all paths and filenames as Variants, not string.
If you look at Ron's code you'll see that's what he does.
As he says on that page:
Note: Do not Dim for example FileNameZip as String in the code
examples. This must be a Variant, if you change this the code will not
work.
I have a problem in a VBScript that I am using with a VBA/Excel macro and a HTA. The problem is just the VBScript, I have the other two components, i.e. the VBA macro and HTA front-end working perfectly. But before I explain the problem, I think for you to help me I must help you understand the context of the VBScript.
So, basically all components (VBScript, VBA macro and HTA) are parts of a tool that I am building to automate some manual chores. It pretty much goes like this:
A - HTA
~~~~~~~~~~~~
User selects some files from the HTA/GUI.
Within the HTML of the HTA there is some VBScript within the "SCRIPT" tags which passes the users 4 input files as arguments to a VBScript (executed by WScript.exe - you may refer to note #1 for clarity here)
The script, lets call it myScript.vbs from now on then handles the 4 arguments, 3 of which are specific files and the 4th is a path/folder location that has multiple files in it - (also see note #2 for clarity)
B - myScript.vbs
~~~~~~~~~~~~
myScript.vbs opens up the first 3 arguments which are Excel files. One of them is a *.xlsm file that has my VBA macro.
myScript.vbs then uses the 4th argument which is a PATH to a folder that contains multiple files and assigns that to a variable for passing to a FileSystemObject object when calling GetFolder, i.e.
... 'Other code here, irrelevant for this post
Dim FSO, FLD, strFolder
... 'Other code here, irrelevant for this post
arg4 = args.Item(3)
strFolder = arg4
Set FSO = CreateObject("Scripting.FileSystemObject"
'Get a reference to the folder you want to search
Set FLD = FSO.GetFolder(strFolder)
...
From here I create a loop so that I can sequentially open the files within the folder
and then run my macro, i.e.
...
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.close
Next
...
Please note that when the first 3 Excel files have opened (controlled by code prior to the loop, and not shown here as I am having no problem with that part) I must keep them open.
It is the files in the folder (that was passed as the 4th argument) which must sequentially open and close. But inbetween opening and closing, I require the VBA/macro (wrote in one of the 3 Excel files previously opened) to run each time the loop iterates and opens a new file from the folder (I hope you follow - if not please let me know :) ).
The problem I am having is that the files in the folder open and close, open and close, n number of times (n = # of files in folder, naturally) without waiting for the macro to run. This is not what I want. I have tried the WScript.sleep statement with a 10 second delay after the 'x1.Run strMyMacro' statement, but to no avail.
Any ideas?
Thanks,
QF.
NOTES:
1 - For simplicity/clarity this is how:
strCMD = cmd /c C:\windows\system32\wscript.exe myScript.vbs <arg1> <arg2> <arg3> <arg4>
'FYI - This is run by creating a WShell object, wsObj, and using the .run method, i.e. WShell.run(strCMD)
2 The HTA employs a piece of JavaScript that strips the users 4th input file (HTML: INPUT TYPE="file") and passes that to the the VBScript within the HTA. This gets me round the problem of not being able to exclusively select a FOLDER in HTML.
You need to tell the run to wait until the process is finished. Something like:
const DontWaitUntilFinished = false, ShowWindow = 1, DontShowWindow = 0, WaitUntilFinished = true
set oShell = WScript.CreateObject("WScript.Shell")
command = "cmd /c C:\windows\system32\wscript.exe <path>\myScript.vbs " & args
oShell.Run command, DontShowWindow, WaitUntilFinished
In the script itself, start Excel like so. While debugging start visible:
File = "c:\test\myfile.xls"
oShell.run """C:\Program Files\Microsoft Office\Office14\EXCEL.EXE"" " & File, 1, true
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
objWMIService.Create "notepad.exe", null, null, intProcessID
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery _
("Select * From __InstanceDeletionEvent Within 1 Where TargetInstance ISA 'Win32_Process'")
Do Until i = 1
Set objLatestProcess = colMonitoredProcesses.NextEvent
If objLatestProcess.TargetInstance.ProcessID = intProcessID Then
i = 1
End If
Loop
Wscript.Echo "Notepad has been terminated."
This may not specifically answer your long 3 part question but this thread is old and I found this while searching today. Here is one shorter way to: "Wait until a process has finished." If you know the name of the process such as "EXCEL.EXE"
strProcess = "EXCEL.EXE"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Do While colProcesses.Count > 0
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Wscript.Sleep(1000) 'Sleep 1 second
'msgbox colProcesses.count 'optional to show the loop works
Loop
Credit to: http://crimsonshift.com/scripting-check-if-process-or-program-is-running-and-start-it/
Probably something like this? (UNTESTED)
Sub Sample()
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'
'~~> Rest of Code
'
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.Close
Do Until IsWorkBookOpen(Fil) = False
DoEvents
Loop
Next
'
'~~> Rest of Code
'
End Sub
'~~> Function to check if the file is open
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function