I would like to convert all XLSX files in a certain directory to CSV files. Each resulting CSV file should only contain the first worksheet of the XLSX file and be saved in a subfolder of the directory.
I am using the following script which works fine, except that it saves all worksheets as a separate CSV. I just need the first.
Could someone tell me how to modify the script? I have very little experience with VBA.
Sub Loop_Through_Files()
Dim WS As Excel.Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myExtension = "*.xl??"
myPath = ActiveWorkbook.Path
myFile = Dir(myPath & "\" & "Input" & "\" & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Open workbook
Set x = Workbooks.Open(Filename:=myPath & "\" & "Input" & "\" & myFile)
SaveToDirectory = ActiveWorkbook.Path
For Each WS In x.Worksheets
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
Next
x.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Replace your for loop with this:
WS = x.Sheets(1)
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
Related
Me again , I'm trying to code for spliting sheets in the xlsm file into the seperate sheet then save them in the same place with the xlsm file. the code as below:
Sub splitsheet()
Dim path As String
Dim cities
ReDim cities(1 To ThisWorkbook.Worksheets.Count)
Dim i As Long
Dim sh As Worksheet
path = ActiveWorkbook.path
For i = 1 To Worksheets.Count
cities(i) = Sheets(i).Name
ActiveWorkbook.SaveAs _
Filename:=path & "\" & Sheets(i).Name & ".xlsx"
'ActiveWorkbook.Close False
Next i
End Sub
The error in my photo below. Why it can not save as in "xlsx" extension , above code is work fine with "xlsm" extension
Filename:=path & "\" & Sheets(i).Name & ".xlsm" 'it can work fine with xlsm extension
My question is how can save as in "xlsx" extension in this case. All assist/explaination will be appriciated.
Please try this code.
Sub EachSheetToEachOwnWorkbook()
' 286
Dim Path As String
Dim Ws As Worksheet
Application.ScreenUpdating = False
Path = ThisWorkbook.Path & "\"
For Each Ws In ThisWorkbook.Worksheets
Ws.Copy
With ActiveWorkbook
.SaveAs Filename:=Path & Ws.Name & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
.Close
End With
Next Ws
Application.ScreenUpdating = True
End Sub
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.
The file is identified (GWB) but jams at the destination command. What am I missing?
Sub MoveCsvFiles()
Dim Wkb As Workbook
Dim SFile As String 'source file
Dim GWB As String
Set Wkb = ThisWorkbook
SFile = Wkb.Path & "\"
GWB = Dir(SFile & "*.csv")
Do While Len(GWB) > 1
Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:=Wkb.Path, Destination:=Wkb.Path & "\Archive\"
GWB = Dir
Loop
End Sub
Found the problem. Source file not identified properly. Thanks all
FSO.MoveFile Source:=Wkb.Path & "\" & GWB, Destination:=Wkb.Path & "\Archive\"
I am currently using this code to open all .xls files in a folder
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = InputBox("Please enter the folder for files")
MyFile = Dir(MyFolder & "\*.xls")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
****Sheet1.Name = "MyFile"****
MyFile = Dir
Loop
End Sub
I am trying to change the worksheet name to the file name as it loops though
Every worksheet I am opening will be called "Parts List"
I am trying to use the asterisk portion to do this but it does not work.
This will rename the Worksheets("Parts List") in the newly opened workbook to MyFile.
Sub OpenFiles()
Dim wb As Workbook
Dim MyFolder As String
Dim MyFile As String
MyFolder = InputBox("Please enter the folder for files")
MyFile = Dir(MyFolder & "\*.xls")
Do While MyFile <> ""
Set wb = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
wb.Worksheets("Parts List").Name = MyFile
MyFile = Dir
Loop
End Sub
Try changing the line to:
Sheets("Sheet1").Name = "MyFile"
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.