I am working on a script that will utilize the built in capabilities of Windows to unzip a supplied .zip file. I am pretty new to vbscript so some of the syntax stumps me a little. I am working with some existing code and trying to modify it so that it will take a command line option for the file name.
If I use the command line to pass the file name, I receive the error:
object required: 'objshell.NameSpace(...)'
If I populate the same variable with text within the script, the script runs error free. Is there some other piece I am missing when attempting to use command arguments?
Here is my code:
Option Explicit
Dim sDestinationDirectory,sLogDestination,fso,outLog,sJunk,sSourceFile
sDestinationDirectory = "C:\scripts\vbscriptTemplates\unzip"
sLogDestination = "C:\scripts\vbscriptTemplates\"
Set fso=CreateObject("Scripting.FileSystemObject")
Set outLog = fso.OpenTextFile("unzipRIP.log", 2, True)
If WScript.Arguments.Count = 1 Then
sSourceFile = WScript.Arguments.Item(0) 'Using this line the code will fail.
'sSourceFile = "C:\scripts\vbscriptTemplates\test.zip" 'Using this line the code will run.
outLog.WriteLine ".:|Processing new zip file|:."
outLog.WriteLine "Processing file: " & sSourceFile
Extract sSourceFile,sDestinationDirectory
Else
sJunk = MsgBox("File to be processed could not be found. Please verify.",0,"Unzip - File not found")
outLog.WriteLine "File to be processed could not be found. Please verify."
outLog.Close
Wscript.Quit
End If
Sub Extract( ByVal myZipFile, ByVal myTargetDir )
Dim intOptions, objShell, objSource, objTarget
outLog.WriteLine "Processing file in subroutine: " & myZipFile & " target " & myTargetDir
' Create the required Shell objects
Set objShell = CreateObject( "Shell.Application" )
' Create a reference to the files and folders in the ZIP file
Set objSource = objShell.NameSpace( myZipFile ).Items()
' Create a reference to the target folder
Set objTarget = objShell.NameSpace( myTargetDir )
intOptions = 4
' UnZIP the files
objTarget.CopyHere objSource, intOptions
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
End Sub
The line referenced is
sSourceFile = WScript.Arguments.Item(0)
This is my attempt to make a variation on the code written by Rob van der Woude.
http://www.robvanderwoude.com/vbstech_files_zip.php#CopyHereUNZIP
Try
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = fso.GetAbsolutePathName(WScript.Arguments.Item(0))
instead of
sSourceFile = WScript.Arguments.Item(0)
Related
My macro will need to read through a very large directory of files and parse data from them. This directory is updated periodically so I am trying to optimize my program to only read files that were added since the last time the program was run.
So far using FileSystemObject it seems I can only read files alphabetically, if I'm not mistaken.
The best solution I have so far is to read all the files every time, create an array containing the file information, sort by DateModified, then open only the files I need. I'm curious to see if I can skip this step by reading files in order of DateModified.
Thanks in advance.
Shell does seem to be a good option here - although I haven't compared performance against a FSO. You could, for example, consider the forfiles command which allows you to retrieve files modified after a specified date?
Some sample code for that would be as follows:
Public Sub RunMe()
Dim fileNames As Collection
Dim path As String
Dim dat As Date
Dim file As Variant
'Set the path and 'find after' date.
path = "c:\user\documents"
dat = #1/1/2018#
'Fetch the files, setting mask as required.
'This example is fetching all .txt files.
Set fileNames = GetFilesModifiedAfter(path, dat, "*.txt")
'Process the list of files.
If Not fileNames Is Nothing Then
For Each file In fileNames
' ... do stuff here.
Debug.Print path & "\" & file
Next
End If
End Sub
Private Function GetFilesModifiedAfter( _
path As String, _
after As Date, _
Optional mask As String) As Collection
Dim cmd As String
Dim piped() As String
Dim result As Collection
Dim i As Long
'Build the command string.
'Date must be formatted as MM/DD/YYYY.
cmd = "cmd.exe /s /c forfiles /p " & _
"""" & path & """" & _
" /d +" & Format(after, "mm/dd/yyyy")
'Add the mask if passed-in.
If mask <> vbNullString Then cmd = cmd & " /m " & mask
'Execute the command and split by /r/n.
piped = Split(CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadAll, vbCrLf)
'Leave if nothing is returned.
If UBound(piped) = -1 Then Exit Function
'Poplate the result collection,
'and remove the leading and trailing inverted commas.
Set result = New Collection
For i = 0 To UBound(piped)
If Len(piped(i)) > 2 Then
result.Add Mid(piped(i), 2, Len(piped(i)) - 2)
End If
Next
'Return the result collection.
Set GetFilesModifiedAfter = result
End Function
Update
I've just done some testing and it seems FSO is quicker, certainly on Folders containing fewer than 100 files. It'd be interesting to run this on really large folders (say a thousand files) as instinctively I feel Shell might have a performance advantage. However, for now, here's the FSO version:
Private Function GetFilesModifiedAfter2( _
path As String, _
after As Date, _
mask As String) As Collection
Dim fso As Object, file As Object
Dim result As Collection
'Instance of objects.
Set fso = CreateObject("Scripting.FileSystemObject")
Set result = New Collection
'Iterate the files and test date last modified property.
For Each file In fso.GetFolder(path & "\").Files
If file.Name Like mask And file.DateLastModified > after Then
result.Add file.Name
End If
Next
'Return the result collection.
Set GetFilesModifiedAfter2 = result
End Function
So I posted a question here:
VBA - Find Specific Sub Folders by Name Identifiers
This question was very broad, but I was facing specific issues I needed help identifying and resolving. Now, I managed to resolve those issues in the original post, however, there is still a good portion of the question unanswered and I would like to close the question only when I am able to post the full result.
Currently, what I still need to do, it the last 4 steps:
Open ZipFile
Look for .png extenstion
Grab the name of the .png file
Put the name in a cell in excel
The issue I am facing, is that of properly opening the zip file. I been through so many posts on this but NOTHING seems to work for me.
The closest I have come to accomplishing the task is what I found here:
https://www.ozgrid.com/forum/forum/help-forums/excel-general/109333-how-to-count-number-of-items-in-zip-file-with-vba-2007
I figure, if at the very least, I am able to enter the zip file, I can then work from there. But alas, I am still stuck at simply trying to open the file.
Here is the code I have (Using from the link above):
Sub CountZipContents()
Dim zCount As Double, CountContents As Double
Dim sh As Object, fld As Object, n As Object
Dim FSO As Object
CountContents = 0
zCount = 0
x = "C:\Users\UserName\Desktop\Today\MyFolder\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(x) Then
For Each FileInFolder In FSO.GetFolder(x).Files
If Right(FileInFolder.Name, 4) = ".png" Then
CountContents = CountContents + 1
ElseIf Right(FileInFolder.Name, 4) = ".Zip" Then
Set sh = CreateObject("Shell.Application")
Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
Debug.Print FileInFolder.Name
For Each fileInZip In ZipFile.Items
If LCase(fileInZip) Like LCase("*.png") Then
CountContents = CountContents + 1
End If
Next
End If
Next FileInFolder
End If
Set sh = Nothing
End Sub
The issue I get is on this line:
For Each fileInZip In ZipFile.Items
Error Message:
Object variable or With block not set
Whenever I tried to use Shell, like below:
Dim oShell As New Shell
I get this error:
User-defined type not defined
With the below:
Link https://msdn.microsoft.com/en-us/library/windows/desktop/bb776890(v=vs.85).aspx
Dim oApp As Object
Set oApp = CreateObject("WScript.Shell")
'get a shell object
Set oApp = CreateObject("Shell.Application")
If oApp.Namespace(ZipFile).Items.count > 0 Then
I get this error:
Object doesn't support this property or method
On this line:
If oApp.Namespace(ZipFile).Items.count > 0 Then
References to links I have tried:
https://wellsr.com/vba/2015/tutorials/open-and-close-file-with-VBA-Shell/
http://www.vbaexpress.com/forum/showthread.php?38616-quot-shell-quot-not-work-in-Excel
Excel VBA - read .txt from .zip files
I just don't understand why this step is taking so much time to complete.
Your main problem is a really simple one: Your path "C:\Users\UserName\Desktop\Today\MyFolder\" contains already a trailing backslash, and when you set your ZipFile-variable, you are adding another one between path and filename. This will cause the shell-command to fail and ZipFile is nothing.
There are some minor problems with the code. I would recommend to use the GetExtensionName of your FileSystemObject to get the extension and convert this to lowercase so that you catch all files, no matter if they are .PNG, .png or .Png
For Each FileInFolder In FSO.GetFolder(x).Files
Dim fileExt As String
fileExt = LCase(FSO.GetExtensionName(FileInFolder.Name))
If fileExt = "png" Then
CountContents = CountContents + 1
Debug.Print "unzipped " & FileInFolder.Name
ElseIf fileExt = "zip" Then
Dim ZipFileName As String, ZipFile, fileInZip
Set sh = CreateObject("Shell.Application")
ZipFileName = x & FileInFolder.Name
Set ZipFile = sh.Namespace(CVar(ZipFileName))
For Each fileInZip In ZipFile.Items
If LCase(FSO.GetExtensionName(fileInZip)) = "png" Then
CountContents = CountContents + 1
Debug.Print "zipped in " & FileInFolder.Name & ": " & fileInZip
End If
Next
End If
Next FileInFolder
Additionally the strong advice to use Option Explicit and define all your variables. And split commands into smaller pieces. This costs you only a few seconds of typing the extra lines but helps you when debugging your code:
' Instead of
' Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
' write
Dim fName as string
fName = x & "\" & FileInFolder.Name; ' Now you can check fName and see the problem.
Set ZipFile = sh.Namespace(CVar(fName))
Try this:
Option Explicit
' Just to test CheckZipFolder
Sub TestZip()
Dim sZipFold As String: sZipFold = "C:\Temp\MyZip.zip" ' Change this to the path to your zip file
CheckZipFolder sZipFold
End Sub
Sub CheckZipFolder(ByVal sZipFold As String)
Dim oSh As New Shell ' For this, you need to add reference to 'Microsoft Shell Controls and Automation'
Dim oFi As Object
' Loop through all files in the folder
For Each oFi In oSh.Namespace(sZipFold).Items
' Checking for file type (excel file in this case)
If oFi.Type = "Microsoft Excel Worksheet" Then
MsgBox oFi.Name
'..... Add your actions here
End If
' This will make the UDF recursive. Remove this code if not needed
If oFi.IsFolder Then
CheckZipFolder oFi.Path
End If
Next
' Clear object
Set oSh = Nothing
End Sub
I have about 5000 .csv files and I want to search for one row in each file and extract it. I have pasted the key part of code below, which works, but as I have to open and close each .csv file, the process is slow for 5000 files. Is there any way to read a csv file without opening it? I had considered writing a small script to convert each csv file to Excel first? Thx.
SP_File_Name = Dir(DN_Path & "*.*")
Count = 1
Set START_CELL_RANGE = TARGET_SP_SHEET.Range("B3")
Set TICKER_CODE_RANGE = TARGET_SP_SHEET.Range("B1")
While (SP_File_Name <> "")
SP_Full_Path = DN_Path & SP_File_Name
Workbooks.OpenText Filename:=SP_Full_Path, DataType:=xlDelimited, comma:=True, Local:=True
Set INPUT_WORKBOOK = ActiveWorkbook
Set INPUT_SHEET = INPUT_WORKBOOK.Worksheets(1)
INPUT_SHEET.Range("$A$1").Select
Set INPUT_RANGE = ActiveCell.CurrentRegion
Set INPUT_FIRST_MATCH_RANGE = INPUT_RANGE.Find(TICKER_CODE_RANGE)
If INPUT_FIRST_MATCH_RANGE Is Nothing Then
GoTo NOT_FOUND
End If
START_CELL = START_CELL_RANGE.Address
TARGET_SP_SHEET.Range(START_CELL_RANGE.Address, START_CELL_RANGE.Offset(0, 6).Address).Value = INPUT_SHEET.Range(INPUT_FIRST_MATCH_RANGE.Address, INPUT_FIRST_MATCH_RANGE.Offset(0, 7).Address).Value
' write diagnostics
Sheet5.Range("K" & Count + 4).Value = START_CELL
Sheet5.Range("L" & Count + 4).Value = "$A$1"
Sheet5.Range("M" & Count + 4).Value = INPUT_FIRST_MATCH_RANGE.Address
Sheet5.Range("N" & Count + 4).Value = INPUT_FIRST_MATCH_RANGE.Offset(0, 7).Address
NOT_FOUND:
Set START_CELL_RANGE = START_CELL_RANGE.Offset(1, 0)
Workbooks(SP_File_Name).Close SaveChanges:=False
SP_File_Name = Dir
Count = Count + 1
Wend
To call a cmd command from VBA, I have used WshShell. For early binding I set a reference to the Windows Script Host Object Model
One problem with the Shell function is that it runs asynchronously. By using the WshShell Run method, you can have it wait until finished before executing subsequent commands.
Sample code might look as follows:
Option Explicit
Sub foo()
Dim WSH As WshShell
Dim lErrCode As Long
Set WSH = New WshShell
lErrCode = WSH.Run("cmd /c findstr /C:""Power"" ""C:\Users\Ron\filelist.txt"" > ""C:\Users\Ron\Results2.txt""", 1, True)
If lErrCode <> 0 Then
MsgBox "Error Code: " & lErrCode
Stop
End If
Set WSH = Nothing
Call Shell
End Sub
With regard to your command that you showed in your comment, I would ensure that VBA is interpreting the string correctly for the cmd prompt. Looking at your code line, I would wonder whether you are missing a space between the search string and the file path.
I don't think you can read the contents of a file without opening it. Why not just merge all 5000 files into 1 single file and read that into Excel. Certainly that will be much faster. Use the Command Window, point it to the folder that contains all 5000 files, and enter this:
copy *.csv merge.csv
See the link below for an example.
http://analystcave.com/merge-csv-files-or-txt-files-in-a-folder/
I have a serie of archives : C:/archive1.zip, C:/archive2.zip, etc.
I want to extract only one file from each archive.
Each archive has same structure and file can found under :
C:/archive1.zip/folderlevel1/folderlevel2/folderlevel3/Myfile.csv
C:/archive2.zip/folderlevel1/folderlevel2/folderlevel3/Myfile.csv
etc.
How can I read all the file Myfile.csv in vba ?
Thanks!
You can do it as this:
'
' UnZip 1 file from a zip file:
'
Function entUnZip1File(ByVal strZipFilename, ByVal strDstDir, _
ByVal strFilename)
'
Const glngcCopyHereDisplayProgressBox = 256
'
Dim intOptions, objShell, objSource, objTarget
'
' Create the required Shell objects
Set objShell = CreateObject("Shell.Application")
'
' Create a reference to the files and folders in the ZIP file
Set objSource = _
objShell.NameSpace(strZipFilename).Items.item(CStr(strFilename))
'
' Create a reference to the target folder
Set objTarget = objShell.NameSpace(strDstDir)
'
intOptions = glngcCopyHereDisplayProgressBox
'
' UnZIP the files
objTarget.CopyHere objSource, intOptions
'
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
'
entUnZip1File = 1
'
End Function
And any where in your macro, call the function to extract the file into C:\temp directory or to any destination folder instead of C:\temp:
entUnZip1File "C:\archive1.zip", "C:\temp", "folderlevel1/folderlevel2/folderlevel3/Myfile.csv"
We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file.
EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*"
EDIT
The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function:
Function OpenWorkbook(strPath As String) As Workbook
On Error GoTo ErrorLabel
Set OpenWorkbook = Workbooks.Open(strPath)
ExitLabel:
Exit Function
ErrorLabel:
If Err.Number = 1004 Then
Resume ExitLabel
Else
'other error handling code here
Resume ExitLabel
End If
End Function
Then you can consume the function like this:
Dim w As Workbook
Set w = OpenWorkbook(file.Path)
If Not (w Is Nothing) Then
'...
The problem you're having has to do with this line:
If file.Type = "Microsoft Excel Worksheet" Then
Try adding and replacing it with this:
// add these lines just AFTER the line 'For Each file In files'
IsXLFile = False
FilePath = file.path
FilePath2 = Right(FilePath, 5)
FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1)
If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True
// replace faulty line with this line
If IsXLFile = True Then
Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not.
Have a nice day.