while running this code its showing bad file name or number
I have stored all my files in "\C:\Users\20098323\Desktop\EXCL\"
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\C:\Users\20098323\Desktop\EXCL\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook)
With wb
'Do your work here
.Worksheets(1).Range("A1").Value = "Hello World!"
End With
End Sub
Remove ActiveWorkbook.Path & and the first \ from the line Pathname = ActiveWorkbook.Path & "\C:\Users\20098323\Desktop\EXCL\"
Pathname = "C:\Users\20098323\Desktop\EXCL\"
ActiveWorkbook.Path & "\C:\Users\20098323\Desktop\EXCL\"
This is your problem. It appends the path to the EXCL folder to the path of your current workbook. So you will end up with something like C:\wherever\you\have\your\workbook\C:\Users\20098323\Desktop\EXCL\. Instead use
Pathname = "C:\Users\20098323\Desktop\EXCL\"
Here's a tip for the future: If it gives you an error, press the debug button and it will show you the line where the error occurred. Then you can hover over the variable names and see their current value.
Related
I have a about 40 files that are IQy files that I can open with Excel and I'm trying to go through all of them and save them as xlsx files. What I have so far in VBA is this
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads"
Filename = Dir(Pathname & ".iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx"
wb.Close
Filename = Dir()
Loop
End Sub
To my understanding this loops through my download file where the iqy files are stored and then saveas in xlsx format. When I run it nothing happens.
UPDATE
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=51
wb.Close
Filename = Dir()
Loop
End Sub
This is what worked for me, the only problem I have now is after it changes every file I get a prompt to import data and all I have to press is ok. Is there a way to automate this part so that I can import the data using the table option.
You need to include a wildcard in order to find your iqy files and your pathname will need an additional folder separator to allow the Open and SaveAs to work:
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI86786\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close
Filename = Dir()
Loop
End Sub
Lastly, to be sure it saves correctly, set the FileFormat parameter when using SaveAs.
I am trying to open file from the same folder as the main workbook. The problem is that the name is not permanent and just one word stays always inside the name - "NAME".
I want to use specific method with Thisworkbook.Path to open the xlsx file but it is not finding the workbook with the code.
that is the relavant part of code:
Sub RemoveDuplicats()
Dim Harel As Workbook
Dim SAP As Workbook
Dim Path As String
Dim Found As String
Path = ThisWorkbook.Path
Found = Dir(Path & "*NAME*.xlsx") 'open SAP report
If Found <> "" Then
Set SAP = Workbooks.Open(Path & Found)
End If
End Sub
ThisWorkbook.Path Returns the path without trailing backslash,
try
Found = Dir ( Path & "\" & "*NAME*.xlsx")
You would need to Loop though all Fiels in this Folder and compare the File Names like this:
Dim StrFile As String
StrFile = Dir(ThisWorkbook.Path & "\*" & ".xlsm")
Do While Len(StrFile) > 0
If StrFile Like "*Name*" Then
MsgBox StrFile 'This will be your File
End If
StrFile = Dir
Loop
I am having problems with my code since it only works in the specific folders but not in all subfolders inside the particular folder.
Could someone please helps to make the code works to all subfolders inside that specific folder? :)
These are my code:
Sub Execute1()
Dim monthstr As String
Dim year As String
Dim monthtext As String
Dim prevmonth As String
Dim prevmonthtext As String
year = Range("D8").Text
monthstr = Trim(Range("D9").Text)
monthtext = Trim(Range("D10").Text)
prevmonth = Trim(Range("D11").Text)
prevmonthtext = Trim(Range("D12").Text)
prevyear = Trim(Range("D13").Text)
'confirmation box before running macro//////////////////////////////////////////////////////////////////////////////////////
response = MsgBox("Are you sure the settings are correct?", vbYesNo, "Confirmation")
If response = vbNo Then
Exit Sub
End If
'optimize macro speed///////////////////////////////////////////////////////////////////////////////////////////////////////////
Call Optimize
'finding the correct path (month)//////////////////////////////////////////////////////////////////////////////////////////
Dim myfile As String
Dim mypath As String
Dim newpath As String
mypath = "C:\Users\praseirw\Desktop\Tes CC\" & prevyear & "\SC\" & prevmonth & " " & prevmonthtext & "\"
myfile = Dir(mypath & "*.xlsx")
newpath = "C:\Users\praseirw\Desktop\Tes CC\" & year & "\SC\" & monthstr & " " & monthtext & "\"
'loop through all files in specified month//////////////////////////////////////////////////////////////////////////////////
Dim root As Workbook
Dim rng As Range
Dim wb As Workbook
Dim ws As Worksheet
Set root = Workbooks("CC Reports Center.xlsm")
Set rng = root.Worksheets("Settings").Range("H7:H14")
Do While myfile <> ""
Set wb = Workbooks.Open(mypath & myfile)
For Each ws In wb.Worksheets
rng.Copy
With ws.Range("D1")
.PasteSpecial xlPasteFormulas
End With
Next ws
Dim oldname As String
Dim newname As String
Dim wbname As String
oldname = wb.Name
wbname = Mid(oldname, 9)
newname = year & "_" & monthstr & "_" & wbname
wb.SaveAs Filename:=newpath & newname
wb.Close
Set wb = Nothing
myfile = Dir
Loop
Application.CutCopyMode = False
MsgBox "Task Complete!"
'reset macro optimization settings//////////////////////////////////////////////////////////////////////////////////////////////
Call ResetOptimize
End Sub
Here's one way to do it with the Dir function. If you want something a little more elegant you may want to consider using a FileSystemObject. (Note that to view Debug.Print output you have to enable the immediate window from under view.)
Sub test()
Dim root As String
root = "C:\"
Dim DC As New Collection
s = Dir(root & "*", vbDirectory)
Do Until s = ""
DC.Add s
s = Dir
Loop
For Each D In DC
Debug.Print D
On Error Resume Next: s = Dir(root & D & "\*.xl*"): On Error GoTo 0
Do Until s = ""
Debug.Print " " & s
s = Dir
Loop
Next
End Sub
Here's an example of how to do this with a FileSystemObject. Note that my code is a little sloppy with "On error resume next" to protect against access denied or other errors. Realistically you may want to consider incorporating better error handling, but that's another topic. Using a FileSystemObject is more powerful than Dir because Dir only returns a string, while FileSystemObject lets you work with files and folders as actual objects, which are much more powerful.
Sub test()
'You can use "CreateObject..." to add a FileSystemObject from the Scipting Library
'Alternatively, you can add a reference to "Microsoft Scripting Runtime"
'allowing you to directly declare a filesystemobject and access related intellisense
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder("C:\")
For Each SubFolder In Folder.SubFolders
Debug.Print SubFolder.Name
On Error Resume Next
For Each File In SubFolder.Files
Debug.Print " " & File.Name
Next
On Error GoTo 0
Next
End Sub
I have a folder which has .csv files, .xls files, and xlsx files. The below code is a portion of an overall project (when I remove the below code, the remaining code achieves what I want). A large chunk of the code was compiled from somewhere (here and around the internet). What I want the code to do is open only the .csv files in the folder, convert them to an Excel file, close the files, and then delete the .csv files in the folder. What ends up happening with the code is that one or both of the files created by the code are deleted from the folder, and I am left with nothing. Thanks in advance for any help.
Sub Test()
'
' Test Macro
'
'Set variables for the below loop
Dim MyFolder As String
Dim MyFile As String
Dim GetBook As String
Dim GetBook2 As String
Dim MyCSVFile As String
Dim KillFile As String
MyFolder = "REDACTED"
MyFile = Dir(MyFolder & "\*.xls")
MyCSVFile = Dir(MyFolder & "\*.csv")
'Open all of the .csv files in the folder and convert to .xls
Do While MyCSVFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyCSVFile
GetBook = ActiveWorkbook.Name
GetBook2 = Left(GetBook, Len(GetBook) - 4)
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetBook2, FileFormat:=56
ActiveWorkbook.Close False
Kill MyFolder & "\" & GetBook
Loop
End Sub
You are not calling the Dir function to get the next file.
Sub Test()
'Set variables for the below loop
Dim myFolder As String
Dim getBook As String
Dim myCSVFile As String
Application.DisplayAlerts = False
myFolder = Environ("TEMP") & Chr(92) & "REDACTED"
myCSVFile = Dir(myFolder & "\*.csv")
Do While myCSVFile <> ""
Workbooks.Open Filename:=myFolder & "\" & myCSVFile
getBook = ActiveSheet.Name '<~ Sheet1 of an opened CSV is the name of the CSV
ActiveSheet.Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=myFolder & Chr(92) & getBook, FileFormat:=56
ActiveWorkbook.Close False
Kill myFolder & Chr(92) & myCSVFile '<~~ delete the CSV, not the workbook
myCSVFile = Dir '<~~ this is important to get the next file in the folder listing
Loop
End Sub
The only worksheet in an opened CSV is named for the CSV (without the .CSV extension) so that can be used in the Workbook.SaveAs method. I've used xlOpenXMLWorkbook as the SaveAs FileFormat type.
I'm pretty new to vba, and I could use some help.
Here is the code am using. This is just a basic macro to call another macro and loop. However, it seems to be skipping everything from workbooks.open through activeworkbook.saveas.
The annoying bit is that I have used this code twice before but with different file names and paths and everything worked.
I have stepped-through the code and it really just seems to be skipping those lines, which it does not do in the original code.
Sub oddball_macro_loop()
'
' oddball_macro_loop Macro
'
'
Dim rawPath As String
Dim rawFile As String
Dim savePath As String
Dim oWB As Workbook
Dim fName As Variant
rawPath = "I:\Cores\DMB\E-Prime Tasks\Salience Task\Data\Macros\Raw\For macro"
rawFile = Dir(rawPath & "*.txt")
savePath = "I:\Cores\DMB\E-Prime Tasks\Salience Task\Data\Macros\Processed"
ChDir (rawPath)
Application.DisplayAlerts = True
Do While rawFile <> ""
Workbooks.Open Filename:="I:\Cores\DMB\E-Prime Tasks\Salience Task\Data\Macros\oddball_macro.xlsm"
Set oWB = Workbooks.Open(rawPath & rawFile)
Application.Run "'oddball_macro.xlsm'!oddball_macro"
Sheets("Data").Select
'Sets File Name
Dim text As String
text = Range("Z12")
fName = Mid(text, 19)
ActiveWorkbook.SaveAs Filename:=savePath & fName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close False
rawFile = Dir()
Loop
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub
If it's skipping those lines then that suggests the result of the Dir() function is null.
it looks like you may be possibly missing a path separator at the end of rawPath? This should fix it:
rawFile = Dir(rawPath & Application.PathSeparator & "*.txt")
Or alternatively just make sure you add that to your assignment statment:
rawPath = "I:\Cores\DMB\E-Prime Tasks\Salience Task\Data\Macros\Raw\For macro\"
Often you'll see people do something like this as a sort of double-check:
If Not right(rawPath, 1) = Application.PathSeparator then
rawPath = rawPath & Application.PathSeparator
End If
rawFile = Dir(rawPath & "*.txt")
Or you could get real fancy and do this:
Dim sep as String
sep = Application.PathSeparator
rawFile = Dir(rawPath & IIF(Right(rawPath,1) = sep, "*.txt", sep & ".txt"))