I have a question regarding looping through a folder of two different kinds of files: xlsm and mdb (Access).
I have currently written a macro that would open 1 single xlsm file and 1 single mdb file before copying some data from the xlsm to mdb file and then saving the mdb file.
Now, I would like this process to repeat through a folder that has 50 xlsm files and 50 mdb files. They have the same names, so for example the loop should do this:
Open both xlsm and mdb files called "2001".
Perform copying and pasting etc from xlsm to mdb (I have written this part).
Save the mdb file.
Close both xlsm and mdb files called "2001".
Repeat steps 1-4 for "2002", "2003", etc in the folder.
I am really new to VBA so much help is appreciated! Looking forward to any guidance at all. Merry Christmas!
I just did today sample code for listing JPG files in folder, you can adopt and modify to do exactly what you like it to do, but would be very hard to give you exact code without being able to see your solution.
Public Sub listImages(folderPath As String)
'define variables
Dim fso As Object
Dim objFolder As Object
Dim objFolders As Object
Dim objF As Object
Dim objFile As Object
Dim objFiles As Object
Dim strFileName As String
Dim strFilePath As String
Dim myList As String
'set file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'set folder object
Set objFolder = fso.GetFolder(folderPath)
'set files
Set objFiles = objFolder.files
Set objFolders = objFolder.subfolders
'list all images in folder
For Each objFile In objFiles
If Right(objFile.Name, 4) = ".jpg" Then
strFileName = objFile.Name
strFilePath = objFile.Path
myList = myList & strFileName & " - " & strFilePath & vbNewLine
End If
Next
'go through all subflders
For Each objF In objFolders
Call listImages(objF.Path)
Next
Debug.Print myList
Set objFolder = Nothing
Set objFile = Nothing
Set fso = Nothing
End Sub
Related
I created documentary list in Excel 2016 for a personal project, it can sort files and remove old versions, create a clickable link to the new version...
I want to update code for better reliability and visibility.
I don't how to create a dynamic list of objects with files properties (size, name, path, creation date...), ex : have these properties(size, name, path...)
I add a piece of my old code.
I tried these tutorials but isn't working or I don't understand :
http://www.cpearson.com/excel/Classes.aspx
How to create an array of objects Visual Basic
https://excel.developpez.com/faq/?page=ModuleClasse
Dim TblFichiers() As String
Dim File As String
Dim I As Integer
If Right(Chemin, Len(Chemin)) <> "\" Then Chemin = Chemin & "\"
File = Dir(Chemin & "*" & Ext & "*")
Do While (Len(File ) > 0)
I = I + 1
ReDim Preserve TblFichiers(1 To I)
TblFichiers(I) = File
File = Dir()
Loop
Getfiles= TblFichiers() 'Getfiles is main function
I know how to do this in C ++ or C# but I have difficulty understanding how it works in VBA.
I think you'd be best to look at the Microsoft Scripting Runtime library ..
Public Sub TraverseFiles()
Dim strFolder As String
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
strFolder = "c:\temp"
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
Debug.Print objFile.Name
Debug.Print objFile.Path
Debug.Print objFile.Size
Debug.Print objFile.DateCreated
Next
End Sub
... it'll give you what you want regarding attributes about files and operations to manage those files.
You just need to adapt it your project.
I hope that works for you.
I am trying to make a macro that opens all .xlsm files in a folder:
C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel\
And copy some cells (from different worksheets).
Information from each file should be assigned only to one row as I will use the first row for titles (ID Nº; Date of visit etc …)
And one row for each file in the folder.
I would really appreciate if you could help me write the macro and tell me how it works as I am not an IT.
I did not understand the second part of your question, but here is a code which opens every xlsm in your given folder:
Sub Xlsmopener()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel")
i = 1
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile.Path) = "xlsm" Then
Workbooks.Open (objFile.Path)
End If
i = i + 1
Next objFile
End Sub
The VBA macro stops running on opening certain workbooks. When I run the code in break mode, it seems like control goes over to the newly opened workbook and there it has no instructions to follow.
I am trying to open a lot of workbooks, take a printout and close them.
I have also tried opening them in Read only mode, setting the calculation mode to manual but nothing has worked so far.
The following will work if you have a folder with all the workbooks.
This code will iterate through a series of excel files in a given folder:
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim intLen As Integer
Dim strName As String
Dim wsSheet As Worksheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPath = "C:\Users\username\Desktop\FolderName" 'Set path of folder with excel files
Set objFolder = objFSO.GetFolder(strPath) 'Get the folder object associated with the directory
For Each objFile In objFolder.Files 'Loop through the files in the folder
Workbooks.Open (strPath & "\" & objFile.Name)
Set wsSheet = Worksheets("Sheet1") 'Name of sheet in excel file
ActiveWorkbook.CheckCompatibility = False 'Skip compatibility check
This code will printout a pdf of the specified range on each sheet to a given path:
intLen = Len(objFile.Name) - 5 'Remove .xlsx characters from name
strName = Left(objFile.Name, intLen)
wsSheet.Range("A1:P58").ExportAsFixedFormat xlTypePDF, "C:\Users\username\Desktop\" & strName & ".pdf", , , , , , False
This code will close each file without saving and continue the loop through the folder:
Workbooks(strName).Close SaveChanges:=False 'Close excel file without saving
Next
I need to traverse a zip files using VBA. In particular I need to, without unzipping the file, locate the xl folder in order to find the media subfolder. I then need to copy the images out of the media subfolder and save them to another folder.
Public Sub Extract_Images()
Dim fso As FileSystemObject
Dim objFile As File
Dim myFolder
Const zipDir As String = "\\...\ZIP FILES"
Const xlFolder As String = "xl"
Const mediaFolder As String = "media"
Dim picname As String
Dim zipname As String
Set fso = New FileSystemObject
Set myFolder = fso.GetFolder(zipDir)
For Each objFile In myFolder.Files
zipname = objFile.Name
Next objFile
End Sub
^That code successfully loops through the folder and gathers the names of the zip files. But I need to get into the files and traverse the structures to get to the Media folder.
Building off: https://www.rondebruin.nl/win/s7/win002.htm
Edit: - this shows how you can incorporate the extraction into your code. Just pass the full zip path and the location to where you want to extract the files. You can do this from within your existing loop.
You may need to account for media files sharing the same name if you're planning on extracting them all to the same location...
Sub Tester()
ExtractMediaFiles "C:\Users\twilliams\Desktop\tempo.zip", _
"C:\Users\twilliams\Desktop\extracted\"
End Sub
Sub ExtractMediaFiles(zipFile As Variant, outFolder As Variant)
Dim oApp As Object
Dim fileNameInZip As Variant, oNS As Object
Set oApp = CreateObject("Shell.Application")
On Error Resume Next
Set oNS = oApp.Namespace(zipFile & "\xl\media")
On Error GoTo 0
If Not oNS Is Nothing Then
For Each fileNameInZip In oNS.items
Debug.Print fileNameInZip
oApp.Namespace(outFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
Next
Else
Debug.Print "No xl\media path for " & zipFile
End If
End Sub
Currently I have a workbook designed to index a folder, where you enter in a folder path e.g. 'Z:\Example' and it exports all the file names and file paths for everything in that particular folder, into another sheet within the workbook. I was wondering if it would be possible to grab all the files within that folder ('Z:\Example') and if there was any other folders inside that directory, also grab all the files within that folder too.
E.g. I enter 'Z:\Example' into cell A19 (as per the code below),
'Z:\Example' has another folder in it, Z:\Example\Another'. All files
within both 'Z:\Example' and Z:\Example\Another' get brought into
excel sheet 2.
Private Sub CommandButton1_Click()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim Source_Workbook As Workbook
Dim Target_Path As String
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Path of the Target Folder
Target_Path = Range("A19").Value
Set Target_Workbook = Workbooks.Open(Target_Path)
Set Source_Workbook = ThisWorkbook
'Get the folder object
Set objFolder = objFSO.GetFolder(Target_Path)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Source_Workbook.Sheets(2).Cells(i + 1, 1) = objFile.Name
'print file path
Source_Workbook.Sheets(2).Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
'Process Completed
msgBox "Task Completed"
End Sub
I would prefer to not have to insert all paths that I want indexed at the beginning but if that is unavoidable it is okay. Any help appreciated.
Thanks
As In the comments, there are many resources to list a folder and its subfolders. This snippet is customized to your application. It uses recursion and needs to be fed the root folder and the target cell where to paste the results.
Private Sub CommandButton1_Click()
'Call the recursive function
ListAllFiles ThisWorkbook.Sheets(1).Range("A19").Value, ThisWorkbook.Sheets(2).Cells(2, 1)
msgBox "Task Completed"
End Sub
Private Sub ListAllFiles(root As String, targetCell As Range)
Dim objFSO As Object, objFolder As Object, objSubfolder As Object, objFile As Object
Dim i As Integer, Target_Path As String
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(root)
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
targetCell.Value = objFile.Name
'print file path
targetCell.Offset(, 1).Value = objFile.Path
Set targetCell = targetCell.Offset(1)
Next objFile
' Recursively call the function for subfolders
For Each objSubfolder In objFolder.SubFolders
ListAllFiles objSubfolder.Path, targetCell
Next objSubfolder
End Sub