I'm trying to loop through and open all files in a folder named (BU) located in the same directory as the sheet where my macro is. I am able to see the myfile get the first file name correctly, but I am getting a run time error 1004 when the workbook tries to open. Any help would be appreciated.
Sub LoopAndOpen()
Dim myfile As String, Sep As String, stringA As String, path1 As String
Sep = Application.PathSeparator
path1 = ActiveWorkbook.Path & Sep & "BU" & Sep
myfile = Dir(path1 & "*.xlsm")
Do While myfile <> ""
Workbooks.Open myfile
myfile = Dir()
Loop
End Sub
Edit: I ended up using Unicco's procedure and it worked perfectly.
You can use this procedure instead.
Modify "ThisWorkbook.Path" and ".xlsm" to your desired purpose. Use InStr(objFile, ".xlsm") Or InStr(objFile, ".xlsx") if you want to open both standard aswell as Excelfiles with macros.
Option Explicit
Sub OpenAllFiles()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each objFile In objFolder.Files
If InStr(objFile, ".xlsm") Then
Workbooks.Open (objFile)
End If
Next
End Sub
Dir() only returns the file name, not the full path: you need to pass the full path to Open() unless the current directory happens to be the one you're searching through. It's best never to rely on that being the case.
Related
Hi im using the below macro to delete first 2 lines of txt files in a folder
Private Sub remove()
Dim FSO, txs, fld, fil As file, content, nLinesToSkip, i
Set FSO = CreateObject("Scripting.FileSystemObject")
nLinesToSkip = 2
fld = FSO.GetFolder("O:\New folder\")
For Each fil In fld
If Right(fil.Name, 3) = "txt" Then
Set txs = fil.OpenAsTextStream(1) ' 1 = for reading
For i = 1 To nLinesToSkip
txs.SkipLine
Next i
content = txs.ReadAll
txs.Close
Set txs = fil.OpenAsTextStream(2) ' 2 = for writing
txs.Write content
txs.Close
End If
Next fil
End Sub
while running this script im getting type mismatch error for line
For Each fil In fld
would appreciate if anyone can assist in solving this issue
.GetFolder isn't doing what you think it is. It returns a folder object. You want the files within the folder.
Try it as,
Set fld = FSO.GetFolder("O:\New folder\")
For Each fil In fld.Files
...
Next fil
TBH, I don't know why you aren't using the simpler Dir with a *.txt file mask.
To Loop through files in a folder use DIR as suggested by Jeeped. You may want to see this stackoverflow link
Loop through files in a folder using VBA
Writing/Manipulating Text file using Excel is a slower process. Here is a much faster process
Sub Sample()
Dim MyData As String, strData() As String
Dim MyFile As String
MyFile = "C:\Users\routs\Desktop\Sample.Txt"
'~~> Read the file in an array in 1 go
Open MyFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Delete old file
Kill MyFile
'~~> Write to new file
Open MyFile For Output As #1
'~~> From 3rd line onwards
For i = 2 To UBound(strData)
Print #1, strData(i)
Next i
Close #1
End Sub
If you do not want to overwrite the old file then change the below lines
'~~> Delete old file
Kill MyFile
'~~> Write to new file
Open MyFile For Output As #1
I am also assuming that there are more than 2 lines in the text file. If not then you will have to handle that accordingly.
As Jeeped answered, it might be easier with the Dir.
Also, opening it with excel makes the operation slightly more simple to my sense.
Sub Test()
Dim StrFile As String
Dim WB As Workbook
Dim K As Integer
Set WB = ActiveWorkbook
StrFile = Dir("O:\New folder\*.txt")
Do While Len(StrFile) > 0
Workbooks.Open Filename:="O:\New folder\" & StrFile
Application.DisplayAlerts = False
Rows("1:2").Delete Shift:=xlUp
ActiveWorkbook.SaveAs Filename:="O:\New folder\" & StrFile, FileFormat:=xlText, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
StrFile = Dir
Loop
End Sub
I'm writing a vba script to
a. copy the contents of one current excel file (with formatting),
b. loop through all other excel files in its current folder,
c. add the new copied worksheet to excel files
For some reason my code is not working. can anyone please help
I'm new in vba scripting
Sub Macro7()
Dim wbf As Workbook
Dim myPath As String
Dim myFile As String
Dim currentFile As String
Dim mtExtension As String
myPath = Application.ActiveWorkbook.Path
currentFile = ActiveWorkbook.Name
MsgBox (myPath)
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(myPath)
Count = 0
For Each objFile In objFolder.Files
If currentFile <> objFile.Name Then
Set wbt = Workbooks.Open(Filename:=myPath & "\" & objFile.Name)
MsgBox (objFile.Name)
.Sheets("Action Descriptions").Select After:=Workbooks(objFile.Name).Sheets(1)
ActiveWorkbook.Save
ActiveWindow.Close
End If
'
Next
' Loop
End Sub
Here you have copied once and pasting multiple times opening multiple files.
Try copying every time inside the loop just before pasting in the other file.
In loop
{
Open new file
Add tab
Activate this workbook
Copy
Go to other file
Paste
Save
Close
}
I am trying to get Excel to open any file in the a given folder
(ThisWorkbook.Path\Peach\Apple) that has .xlsm extension (there is always only 1 file). Is it possible to open it with wildcard character? I do not know the name of the file, just the extension.
If not, is there a way to do it?
Just ask the file system for the first matching file:
Dim path As String: path = ThisWorkbook.path & "\Peach\Apple\"
FindFirstFile = Dir$(path & "*.xlsm")
If (FindFirstFile <> "") Then
Workbooks.Open path & FindFirstFile
Else
'// not found
End If
(This will not search sub-directories)
You mentioned that it would be nice addition to open last modified file or file with shortest name, so let's start - there's a code example how you can grab all three files (first finded, last modified, with shortest name). You can modify this as you wish (add some parameters, add error handling, return only specified, etc).
Sub Test()
'declarations
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim path As String
Dim first_finded As Object
Dim recently_modified As Object
Dim shortest_name As Object
Dim recently As Date
Dim shortest As Long
Dim firstFinded As Boolean
'setting default recently date(24 hours from now) and path
recently = DateAdd("h", -24, Now)
path = ThisWorkbook.path & "\Peach\Apple\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
'iteration over folder
For Each file In folder.Files
If file.Name Like "*.xlsm" Then
'grab first finded .xlsm
If Not firstFinded Then
firstFinded = Not firstFinded
Set first_finded = file
End If
'grab lastmodified .xlsm
If file.DateLastModified > recently Then
recently = file.DateLastModified
Set recently_modified = file
End If
'grab short named .xlsm
If shortest = 0 Or shortest > Len(file.Name) Then
shortest = Len(file.Name)
Set shortest_name = file
End If
End If
Next
'debug-print names
Debug.Print first_finded.Name
Debug.Print recently_modified.Name
Debug.Print shortest_name.Name
'so now you can uncomment this and open what you want
'Call Workbooks.Open(path & recently_modified.Name)
End Sub
Try the code below, it will open your "*.xlsm" file, in the path you've requested.
Sub OpenXLSMWildcardfile()
Dim Path As String
Path = ThisWorkbook.Path & "\Peach\Apple\"
Workbooks.Open (Path & "*.xlsm")
End Sub
PFB for the code required for opening the macro file with extension(.xlsm).
Sub OpeningFile()
'Declaring variables
Dim FileName, FolderPath As String
'Initializing folder path
FolderPath = ThisWorkbook.Path & "\Peach\Apple\"
'Finding the file name using wildcard
FileName = Dir(FolderPath & "*.xlsm")
'Looping through the workbook which are saved as macro enabled workbooks
While FileName <> ""
Workbooks.Open FolderPath & FileName
FileName = Dir()
Wend
End Sub
I have 200 folders all with different names in a folder. Now, each folder with a different name has a macro excel file (.xlsm). I'm trying to edit all the files at once with a separate file. The code goes like this:
Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "*.xlsm")
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName , ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
ws.Range("A1").Interior.ColorIndex = 0
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
But this doesn't work. I have tried tweaking it but whatever i do either does nothing or causes an error. Can someone please help me get this code to work.
(also: "testing main folder" is the folder on my desktop which holds the 200 other folders which hold the .xlsm files.)
Put Option Explicit at the top of the module. You'll get some compiler errors, one of them being that strFileName isn't declared. This would have been a great clue as to where to look, because the problem is that you're using two variable names that have roughly the same meaning when you read them, and they're getting mixed up.
After you're done fixing the variables, take a look at the documentation for the Dir function. The second issue is that you're also calling Dir multiple times in the loop, which means that you're skipping results.
It should look something more like this:
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim file As String
'path never changes, so make it a Const
Const path = "C:\Users\generaluser\Desktop\testing main folder\"
'This returns the first result.
file = Dir$(path & "*.xlsm")
Do While file <> vbNullString
Set wb = Workbooks.Open(Filename:=path & file, ReadOnly:=False)
Set ws = Application.Worksheets(1)
'Do whatever
wb.Close SaveChanges:=True
'This returns the next result, or vbNullString if none.
file = Dir$
Loop
I am trying to convert a directory full of .txt files to .xls using VBA. I am using the following code:
Sub TXTconvertXLS()
'Variables
Dim wb As Workbook
Dim strFile As String
Dim strDir As String
'Directories
strDir = "\\xx\xx\xx\xx\Desktop\Test\Test1\"
strFile = Dir(strDir & "*.txt")
'Loop
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".txt", ".xls"), 50
.Close True
End With
Set wb = Nothing
Loop
End Sub
The issue is: when I run it, it immediately states that there is already a file with the name it's trying to save with in the directory. The name it shows even has a .xls extension, even if there are assuredly no .xls's in the directory yet! Any help would be greatly appreciated - thanks!
You seem to be missing strFile = Dir before Loop. Without it you are reprocessing the same TXT file.
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".txt", ".xls"), 50
.Close False '<-already saved in the line directly above
End With
Set wb = Nothing
strFile = Dir '<- stuffs the next filename into strFile
Loop
See Dir Function