Good Morning,
I have some code that is doing the basis of what I want, BUT I just need to take it one step further for it to work perfectly. Currently I'm pulling every file in the folders and subfolders which is proper, but now I need to select only files that have a particular version label: "v5.3.xlsx" so I can open them, make adjustments and close. I've tried every version of a wild card search I can think of but I'm not terribly well versed in VBA so I was hoping someone could kick this over the finish line for me. Any help is very much appreciated!
Sub loopAllSubFolderSelectStartDirectory()
'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("C:\Users\smith\Desktop\Excel Test File\Client\")
End Sub
'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)
Dim fileName As String
Dim myFile As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
Application.ScreenUpdating = False
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & ".", vbDirectory)
While Len(fileName) <> 0
If Left(fileName, 1) <> "." Then
fullFilePath = folderPath & fileName
If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
Else
'Insert the actions to be performed on each file
'This example will print the full file path to the immediate window
Debug.Print fullFilePath
End If
End If
fileName = Dir()
Wend
For i = 0 To numFolders - 1
LoopAllSubFolders folders(i)
Next i
Application.ScreenUpdating = True
End Sub
Related
I need help understanding why file name extraction from string only works every other time.
I've tried both right and mid. I've used before in other code with no problem. I'm useing msgbox for debugging.
Final outcome should be adding multiple file names to the bottom of a table
Private Sub ButtonAdd_Click()
Dim fd As FileDialog
Dim fName As String ' full path file name
Dim nextRow As Long
Dim filename As String ' extracted file name only
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Please select file to add"
fd.InitialFileName = ThisWorkbook.FullName
fd.AllowMultiSelect = True
fchosen = fd.Show
If fchosen = -1 Then
For i = 1 To fd.SelectedItems.Count
fName = fd.SelectedItems(i)
'filename = Right(fName, Len(fName) - InStrRev(filename, "\"))
filename = Mid(fName, InStrRev(filename, "\") + 1)
MsgBox (filename)
nextRow = Range("a" & Rows.Count).End(xlUp).row + 1
'Range("a" & nextRow) = filename
Next i
End If
End Sub
As Josh writes in the comments, you are using the wrong variable filename instead of fname. Another example of how nesting commands makes it difficult to find an error and how naming of variables matters.
Split the lines into two pieces and rename fname to something like fullFilename:
Dim fullFilename as string, filename as string, p as long
fullFilename = fd.SelectedItems(i)
p = InStrRev(fullFilename, "\")
if p > 0 then
filename = mid(fullFilename, p+1)
else
filename = fullFilename
End If
Now you can easily distinguish between the variable holding the full path and the one that has only the file name. And even if you mix something up, you can easily find the problem using the debugger
Take your pick
Get File Name From File Path
Option Explicit
Sub Sample()
MsgBox GetFilenameFromPath("C:\Temp\Myfile.Txt")
End Sub
Private Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath( _
Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Get File Name Without Extension
Option Explicit
Sub Sample()
Dim fName As String
fName = "C:\Temp\Myfile.Txt"
MsgBox GetFilenameFromPath(Left(fName, (InStrRev(fName, ".", -1, vbTextCompare) - 1)))
End Sub
Private Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath( _
Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
I'm completely new to VBA and had some trouble googling this problem cause variable has multiple meanings.
I am trying to open a file and assign its name to a variable. The file's name is never the same though I always download it to the same folder (one file in that folder only). The only recognizable thing about the file are 3 letters "ABC".
So far I managed to get opening the file to work but not assigning the non-standardized file name to a variable.
Sub openwb()
Dim wb As Workbook Dim directory As String
directory = "D:\Users\AAA\Desktop\Practice"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(directory)
For Each file In folder.Files
If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then
Workbooks.Open directory & Application.PathSeparator & file.Name
End If
Next file
End Sub
Public Sub RecordFileName()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "D:\Users\AAA\Desktop\Practice"
sFile = sPath & "*ABC*"
End Sub
Here is a function you can use. It will return the filename you are looking for, and you can specify a file pattern if you want to, or you can omit that argument and it will assume all files.
Function GetFullFileName(sFolder As String, Optional sPattern As String = "*") As String
Dim sFile As String
' ensure sFolder ends with a backslash
If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
sFile = Dir(sFolder & sPattern)
If sFile = "" Then
MsgBox "NOT FOUND: " & sFolder & sPattern
End
End If
GetFullFileName = sFolder & sFile
End Function
Usage:
MsgBox GetFullFileName("C:\Users\Fred\Documents")
Or
MsgBox GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
Or
sFullFile = GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
im trying to get file name with csv extension , but when i try to debug.print it always print the .csv file and the .txt file
im search the file in the folder and subfolder
heres the code
Sub LoopAllSubFolders(ByVal folderPath As String)
Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)
While Len(fileName) <> 0
If Left(fileName, 1) <> "." Then
fullFilePath = folderPath & fileName
If (GetAttr(fullFilePath) And vbDirectory And Not (fullFilePath Like "*csv*")) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
Else
'Insert the actions to be performed on each file
'This example will print the full file path to the immediate window
Debug.Print folderPath & fileName
End If
End If
fileName = Dir()
Wend
For i = 0 To numFolders - 1
LoopAllSubFolders folders(i)
Next i
End Sub
The code i get from website and i add not like "*csv*"
perhaps someone can correcting the code,
thankyou
You can use Dir(folderPath & "*.csv") to find all csv files in folderPath.
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.csv")
While Len(fileName) <> 0
If Left(fileName, 1) <> "." Then
fullFilePath = folderPath & fileName
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
End If
fileName = Dir()
Wend
new edition: use FileSystemObject
Use FileSystemObject to get names of subfolders then get all csv files in each subfolder
Dim fso as object, mainFolder as object, subFolder as object, file
set fso = createobject("Scripting.FileSystemObject")
if fso.FolderExists("folderPath") Then
set mainFolder = fso.getfolder("folderPath")
else
exit sub
end if
for each subFolder in mainFolder.subfolders
for each file in subFolder.Files
if file.name like "*.csv" then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = file
numFolders = numFolders + 1
end if
next file
next subFolder
My suggestion:
fullFilePath = folderPath & fileName
If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
Else
If Right(fileName, 4) = ".csv" Then 'new line
'Insert the actions to be performed on each file
'This example will print the full file path to the immediate window
Debug.Print folderPath & fileName
End If
Sorry for my bad English :( I have a task - i should write a program in Excel VBA,that will in folder and subfolders find all .xml files, scan them and make changes if it necessary. Then program will save all changed files in the folder with name "Todays date_changed" and all non-changed files just transfer to the folder with name "Today date". In the end program should display message about how many files was changed and non-changed. I've already wrote code, that changed .xml file in the proper condition. Here it is:
Sub EditXML()
Dim doc As New DOMDocument
Const filePath As String = "D:\Test3.xml" 'path to the editing file
Dim isLoaded As Boolean
isLoaded = doc.Load(filePath)
If isLoaded Then
Dim oAttributes As MSXML2.IXMLDOMNodeList
Set oAttributes = doc.getElementsByTagName("Operation")
Dim attr As MSXML2.IXMLDOMAttribute
Dim node As MSXML2.IXMLDOMElement
Dim tdate As String
tdate = Format(Now(), "yyyy-mm-dd")
For Each node In oAttributes
If (node.getAttributeNode("Client") Is Nothing) Then
node.setAttribute "Client", "UL"
End If
For Each attr In node.Attributes
If attr.Name = "Client" Then
If attr.Value <> "UL" Then
attr.Value = "UL"
End If
ElseIf attr.Name = "Date" Then
If attr.Value <> "tdate" Then
attr.Value = tdate
End If
End If
Next attr
Next node
doc.Save filePath
End If
End Sub
Also i wrote a code, that in theory should pick all .xml files in the selected folder, editing them and then save to specific folder, but it doesn't do anything-it compiles, doing something, but saves nothing. Here it is:
Sub EditXML()
Dim MyFolder As String
Dim MyFile As String
Dim oDoc As MSXML2.DOMDocument
Dim doc As New DOMDocument
On Error Resume Next
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\"
End With
MyFile = Dir(MyFolder & "*.xml")
Do While MyFile <> ""
oDoc.Load (MyFolder & MyFile)
Dim oAttributes As MSXML2.IXMLDOMNodeList
Set oAttributes = doc.getElementsByTagName("Operation")
Dim attr As MSXML2.IXMLDOMAttribute
Dim node As MSXML2.IXMLDOMElement
Dim tdate As String
tdate = Format(Now(), "yyyy-mm-dd")
For Each node In oAttributes
If (node.getAttributeNode("Client") Is Nothing) Then
node.setAttribute "Client", "UL"
End If
For Each attr In node.Attributes
If attr.Name = "Client" Then
If attr.Value <> "UL" Then
attr.Value = "UL"
End If
ElseIf attr.Name = "Date" Then
If attr.Value <> "tdate" Then
attr.Value = tdate
End If
End If
Next attr
Next node
doc.Save "D:\Test\Output\*.xml"
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
So, at conclusion, i asking for help in writing this program, because this is my first try to write something in VBA. I need parts of code, that will scaning for xml in folders and subfolders, editing them as i mentioned up here and saving the to a proper folder (depending on whether they were changed or not), as i describe in the begining and messaging about working. Here is an example of xml files with which i working:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Document>
<Operations>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06"/>
</Operations>
</Document>
Thank you very much for your help :)
Wow. You are trying to do A LOT of things here. Let's start with a couple items, make sure you get that working, and then build out additional features over time. For starters, you can edit all XML files in a folder in this way.
Sub ReplaceStringInFile()
Const sSearchString As String = "c:\your_path_here\*.xml"
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Dim sFilePath As String
sFileName = Dir(sSearchString)
Do While sFileName <> ""
sFilePath = "c:\temp\" & sFileName 'Get full path to file
iFileNum = FreeFile
sTemp = "" 'Clear sTemp
Open sFilePath For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
sTemp = Replace(sTemp, "THIS", "THAT")
iFileNum = FreeFile
Open sFilePath For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
sFileName = Dir() 'Get the next file
Loop
End Sub
Now, that goes into a single folder to look for XML files, but you said you want to go through all folders and all sub-folders in a directory, right, so you have a recursively loop through this 'list' of folders. You can use the code below to do that.
Sub loopAllSubFolderSelectStartDirector()
'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("C:\your_path_here\")
End Sub
'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)
Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)
While Len(fileName) <> 0
If Left(fileName, 1) <> "." Then
fullFilePath = folderPath & fileName
If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
Else
'Insert the actions to be performed on each file
'This example will print the full file path to the immediate window
Debug.Print folderPath & fileName
End If
End If
fileName = Dir()
Wend
For i = 0 To numFolders - 1
LoopAllSubFolders folders(i)
Next i
End Sub
I need the VBA code to import selected spreadsheets from multiple excel files into access 2007 table.
Can anyone help?
This is the code I have so far.
Option Compare Database
Option Explicit
Const strPath As String = "C:\Users\person\Documents\files.xlsx"
Dim strFile As String
Dim strFileList() As String
Dim intFile As Integer
Sub Sample()
strFile = Dir(strPath & "*.xls")
strFile = Dir(strPath & "*.xls")
While strFile <> ""
'adding files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
If intFile = 0 Then
MsgBox "No Files Found"
Exit Sub
End If
'going through the files and linking them to access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferSpreadsheet acLink, , _
strFileList(intFile), strPath & strFileList(intFile), True, "A5:J17"
Next
MsgBox UBound(strFileList) & "Files were linked"
End Sub
I don't understand all of what's going on with that code, but my hunch is it's not doing what you expect.
You declare a constant, strPath.
Const strPath As String = "C:\Users\person\Documents\files.xlsx"
Later, you concatenate "*.xls" to that constant and feed it to the Dir() function.
Sub Sample()
strFile = Dir(strPath & "*.xls")
I think you should try Debug.Print at that point ...
Debug.Print strPath & "*.xls"
... because the string you're giving Dir() makes it equivalent to this statement:
strFile = Dir("C:\Users\person\Documents\files.xlsx*.xls")
I doubt that matches any of the Excel files you want to process.
See whether the following code outline is useful. I don't see a need to first populate an array, then cycle through the array to link the spreadsheets. I don't see why you should need an array at all here. Avoid it if you can because the code will be simpler and ReDim Preserve is a performance-killer.
Sub Sample2()
Const cstrFolder As String = "C:\Users\person\Documents\"
Dim strFile As String
Dim i As Long
strFile = Dir(cstrFolder & "*.xls")
If Len(strFile) = 0 Then
MsgBox "No Files Found"
Else
Do While Len(strFile) > 0
Debug.Print cstrFolder & strFile
' insert your code to link to link to it here '
i = i + 1
strFile = Dir()
Loop
MsgBox i & " Files were linked"
End If
End Sub