I'm using the code by Ron (http://www.rondebruin.nl/win/s7/win002.htm) to, in theory, unzip a bunch of zip files in a folder. I believe what I have below is the code that takes each zip file in my 'Downloads' directory, creates a new folder with the name of the zip file without the ".zip", and then extracts the files into the new folder. I am not getting any errors (many times people get the runtime error 91) but the only thing that happens is that it creates a bunch of correctly named folders but they are all empty.
Sub UnZipMe()
Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String
'Your directory where zip file is kept
str_DIRECTORY = "C:\Users\Jennifer\Downloads\"
'Loop through all zip files in a given directory
str_FILENAME = Dir(str_DIRECTORY & "*.zip")
Do While Len(str_FILENAME) > 0
Call Unzip1(str_DIRECTORY & str_FILENAME)
Debug.Print str_FILENAME
str_FILENAME = Dir
Loop
End Sub
Sub Unzip1(str_FILENAME As String)
Dim oApp As Object
Dim Fname As Variant
Dim FnameTrunc As Variant
Dim FnameLength As Long
Fname = str_FILENAME
FnameLength = Len(Fname)
FnameTrunc = Left(Fname, FnameLength - 4) & "\"
If Fname = False Then
'Do nothing
Else
'Make the new folder in root folder
MkDir FnameTrunc
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
End If
End Sub
The problem is you are not giving windows enough time to extract the zip file. Add DoEvents after the line as shown below.
TRIED AND TESTED
oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
DoEvents
Related
I'm trying to copy the PDF files from a mapped remote directory to my local machine using the CopyFolder method. I'm getting a 'permission denied' error, and I believe it may be trying to copy hidden or system files. I'm wanting to preserve the folder structure from the source, and only need the PDFs. Is there a way to do this with CopyFolder, or should I use a shell command like robocopy instead?
Here's my code so far:
Public Sub DownloadFiles(FSOFolder As Object)
Dim MyFSO As FileSystemObject
Set MyFSO = New Scripting.FileSystemObject
Dim FSOSubFolder As Object
Dim FSOFile As Object
MyFSO.CopyFolder FSOFolder.path & "*", "C:\Users\UserName\Desktop\Temp"
'code continues
The folders are created, but it seems to error when it tries to copy the first file. Thanks everyone for your suggestions.
You could try copying the files individually with error handling to ignore files that you don't have permission to copy. You will need to create the folders manually under this approach.
Here is a sample code to show the concept. I did not test it.
Sub CopyFiles()
Dim FSO as FileSystemObject
Dim DestinationFolder as Folder
Dim CopyFolder as Folder
Set FSO = New FileSystemObject
Set DestinationFolder = FSO.GetFolder("Your Path to Copy To")
Set CopyFolder = FSO.GetFolder("Your Path to Copy From")
Call Recurse(CopyFolder, DestinationFolder)
End Sub
Sub Recurse(CopyFolder as Folder, DesintationFolder as Folder)
Dim SubFolder as Folder
Dim File as File
On Error Resume Next
For Each File in CopyFolder.Files
FSO.CopyFile(File.Path, DestinationFolder.Path & "\")
Next File
On Error GoTo 0
For Each SubFolder in CopyFolder.Subfolders
Call Recurse(SubFolder, FSO.CreateFolder(DestinationFolder.Path & "\" & SubFolder.Name))
Next SubFolder
End Sub
Let me know if you have any issues with this.
So here's the scenario. Everyday, there is a Zip file created called "Bundle_06112018063917" (The numbers are the date and time at which the zip is created, therefore they change everyday).
The code below extracts all the files into a separate folder beautifully!
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim ShellApp As Object
'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(unzipToPath).CopyHere
ShellApp.Namespace(zippedFileFullName).items
End Sub
Sub Dump()
Call UnzipAFile("G:\DP\Mstanley\history\JUN18\WESTROCK\Bundle_06112018063917.zip", _
"G:\DP\Mstanley\history\JUN18\WESTROCK\Dump")
End Sub
The Problem:
The name of the zip file changes everyday based on the date and time in which the zip is created. Therefore I need a way to refer to zip file with just "Bundle_".
Below is what I tried, but still no luck.
Sub doingstuff()
Dim pSTR As String
Dim strFile As String
Dim WB As Workbook
Dim dirFile As String
pSTR = "G:\DP\Mstanley\history\JUN18\WESTROCK\"
strFile = "Bundle_" & "*" & ".zip"
dirFile = Dir(pSTR & strFile)
Call UnzipAFile(dirFile, "G:\DP\Mstanley\history\JUN18\WESTROCK\Dump")
End Sub
Any ideas/help would be much appreciated!
You need to loop through all the files and do whatever you want to the files that you want to handle.
When you're done, move the file to an archive folder.
Dim di As DirectoryInfo = New DirectoryInfo("C:\ExampleDir\")
For Each fi In di.GetFiles()
' Unzip file file
' do stuff to the contents
' move the file to an archive folder
Next
I changed the signature of your UnzipAFile sub. Do you really want to accept any variable type or do you want strings?
This will search a folder for the latest "Bundles_" file and unzip that one. I couldn't make sense of the "date" at the end of the bundles files so I'm using the Date Modified on the zip file itself.
This solution required a reference to Microsoft Scripting Runtime (the scrrun.dll file)
Sub UnzipLatest(bundlesFolder As String, unzipToPath As String)
Dim fil As File, fol As Folder
Dim fso As New FileSystemObject
Dim latestDate As Date, latestFile As String, latestBundleFileFound As Boolean
If Not fso.FolderExists(bundlesFolder) Then Exit Sub
Set fol = fso.GetFolder(bundlesFolder)
For Each fil In fol.Files
If fil.Name Like "*Bundles_*" Then
latestBundleFileFound = True
If fil.DateLastModified > latestDate Then
latestDate = fil.DateLastModified
latestFile = fil.path
End If
End If
Next
If latestBundleFileFound Then
UnzipAFile latestFile, unzipToPath
End If
End Sub
Sub UnzipAFile(zippedFileFullName As String, unzipToPath As String)
End Sub
I’ve made a simply macro to change names of files in a directory. At first it seemed correct, but then I’ve noticed something strange. For instance there is 48 files in a directory and initially the macro numbers files properly – “1”, “2”, “3” and so forth (in Immediate window the variable “i” changes from 1 to 49), but if I run the macro several times, sometimes the variable “i” changes from 1 to 148 and a first number of files starts from 100: “100”, “101”, “102” et cetera. Then I run the macro again and it counts files properly, then – again – an error mentioned above occurs … and so on. I don’t see any rule in it. Any help is greatly appreciated.
Sub nameChange()
Dim source As FileSystemObject
Dim fold As folder
Dim fObj As File
Dim path As String, newName As String, number As String, ext As String
Dim i As Long
On Error GoTo closeSub
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End With
Set source = New FileSystemObject
Set fold = source.GetFolder(path)
i = 1
newName = InputBox("New name")
For Each fObj In fold.Files
ext = Mid(fObj.Name, (InStrRev(fObj.Name, ".")))
Name fObj As path & "\" & newName & i & ext
i = i + 1
Next fObj
closeSub:
Exit Sub
End Sub
I run this vba which goes through folders and pulls data which it compiles together in one big sheet. My issue is I was getting errors for hidden files called thumbs.db and I need to add something so that it verifies that it is only pulling files with xlsx extensions. Below is the code I am using.
Sub DoFolder(Folder)
Dim SubFolder As Folder
Dim i As Integer
Dim CopyR As Range
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
If Folder.SubFolders.Count = 0 Then
If Folder.Files.Count = 1 Then
If Mid(Folder.Files, Len(Folder.Files) - 3, 4) = "xlsx" Then
Else: MsgBox "2+ files: " & Folder.Path
End If
End If
For Each File In Folder.Files
Hoover File
Next
Else
End If
End Sub
The line I am having issues with figuring out is
If Mid(Folder.Files, Len(Folder.Files) - 3, 4) = "xlsx" Then
Any help on this would be really appreciated
Folder.Files is a collection not a string.
Recursive File Search:
Sub DoFolder(FolderName As String, Optional fso As Object)
Dim f As Object, MySubFolder As Object, RootFolder As Object
Dim cFiles As Collection
If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
Set RootFolder = fso.GetFolder(FolderName)
For Each MySubFolder In RootFolder.SubFolders
DoFolder MySubFolder.Path, fso
Next
Set cFiles = New Collection
For Each f In RootFolder.Files
If f.Name Like "*xls*" Then cFiles.Add f
Next
If cFiles.Count > 0 Then
MsgBox cFiles.Count & " files found in " & RootFolder.Name
For Each f In cFiles
Hoover f
Next
End If
End Sub
A quick solution is simply to check for xlsx being contained in the name of the file. Like this:
If InStr(1,"FileName","xlsx",vbTextCompare)<1 then
Thus, you would be in the safe side, unless someone renames thumbs.db to thumbsxlsx.db.
Assuming you're using the FileSystemObject, which it looks like you are even though we can't see the declarations, and assuming you're only wanting to call Hoover for .xlsx files you can use the following code
If Right(File.Name, 4) = "xlsx" Then
Hoover File
End If
As a further improvement to the answer by user6432984.. FSO does have a function to obtain the file extension, but the function is not part of the File object, but is the fso.GetExtensionName()
You would expect that the File.Type property could be used, but that gives the application name associated with that file extension - not very useful.
If f.Type Like "*xls*" Then cFiles.Add f
However the FSO-based function works as follows:
For Each f In RootFolder.Files
If fso.GetExtensionName(f.Path) Like "*xls*" Then cFiles.Add f
Next
I am working on a project in VBA where I'm searching a directory for files of a certain date that also meet other criteria, and all of that is working fine. What I am stuck on, which should be a trivial issue, is that when I try to use FileCopy to copy the file to another folder, I keep getting a path/file access error. This confuses me because I am pulling the path directly from the FileItem I'm using to search for the criteria, I'm the person who created both the source and destination folders, and put the files in the source folder. Any thoughts?
Sub ListFilesInFolder()
Dim counter As Integer
Dim theString1 As String, theString2 As String
theString1 = "ISA*00*"
theString2 = "ISA|00|"
Dim line As String, fileName As String
Dim datestring As String
'datestring = Format(FileItem.DateLastModified, "mm/dd/yyyy")
Dim today As String
today = Format(DateAdd("d", -2, Date), "mm/dd/yyyy")
Dim destinationFolder As String
destinationFolder = "C:\Users\kragan\Desktop\test\folder2"
Dim file As TextStream
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Set SourceFolder = FSO.GetFolder("C:\Users\kragan\Desktop\test\folder1")
Dim FileItem As Scripting.file
For Each FileItem In SourceFolder.Files
datestring = "10/18/2015"
If (datestring = today) Then
Do While (SourceFolder <> "")
Set file = FSO.OpenTextFile(FileItem)
counter = 0
Do While Not file.AtEndOfLine And counter < 1
line = file.ReadLine
If InStr(1, line, theString1, vbTextCompare) > 0 Or InStr(1, line, theString2, vbTextCompare) > 0 Then
fileName = "C:\Users\kragan\Desktop\test\folder1\" + FSO.GetBaseName(FileItem) + ".AETCLS"
'The line where I get the error:
FileCopy fileName, destinationFolder
file.Close
counter = counter + 1
Exit Do
End If
Loop
Loop
End If
Next FileItem
MsgBox ("done")
End Sub
You need to specify destination folder + destination file name (and not only destination folder).
So this will work:
FileCopy fileName, destinationFolder & "\" & FSO.GetBaseName(FileItem) & ".AETCLS"
You were probably assuming this will work like a file manager application, where giving destination folder is enough... :) But when programming, you need to specify destination path exactly as it is, i.e. including the file name.
One of my friends was getting similar error on creating directory newdir1\newdir2\newdir3. It was not working despite his best effort. But the solution was to create newdir1, then it became possible to specify newdir1\newdir2, then finally newdir1\newdir2\newdir3. Programming file operations does not do the job often seen in file managers, but everything must be specified in detail and performed in elementary steps.
Thanks for your help. What I discovered is that you have to have the full destination path, including the file name, even though it isn't changing. Solved!