I am trying to create a button in a .xlsm that will convert each of the ~100 .xlsx files in the myFolder directory to .txt. The below VBA code returns an Expected End Suberror. The data is always in `Sheet 1" even though there may be other sheets present.
The Dos command executes and converts the files but they are unreadable (something to do with excels formatting?). I am not sure what to do? Thank you :)
Dos
cd C:\Users\Desktop\folder
Copy *.xlsx *.txt
VBA
Option Explicit
Private Sub CommandButton1_Click()
Dim oFSO, myFolder
Dim xlText
myFolder = "C:\Users\Desktop\folder"
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlText = -4158 'Excel txt format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile In oFileList
If (Right(oFile.Name, 4) = "xlsx") Then
Set oWB = oExcel.Workbooks.Open(oFile.Path)
For Each oWSH In oWB.Sheets
Call oWSH.SaveAs(oFile.Path & ".txt", FileFormat:=xlTextWindows)
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
The first lines of your code belong in Private Sub CommandButton1_Click()
(it has to be closed by End Sub)
Option Explicit and proper code indentation can help in this situation
Try this version:
Option Explicit
Private Sub CommandButton1_Click()
Dim myFolder As String
myFolder = "C:\Users\Desktop\folder"
ConvertAllExcelFiles myFolder
MsgBox "Done!"
End Sub
Public Sub ConvertAllExcelFiles(ByVal folderPath As String)
Dim xlApp As Object, wb As Workbook, ws As Variant, fso As Object
Dim fileList As Object, itm As Object, fileName As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileList = fso.GetFolder(folderPath).Files
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
For Each itm In fileList
If Right(itm.Name, 4) = "xlsx" Then
Set wb = xlApp.Workbooks.Open(itm.Path)
fileName = fso.GetParentFolderName(itm.Path) & "\" & fso.GetBaseName(itm.Path)
If True Then 'if converting all sheets use For loop (Change True to False)
wb.Sheets(1).SaveAs fileName & ".txt", FileFormat:=xlTextWindows
Else
For Each ws In wb.Sheets
ws.SaveAs fileName & " - " & ws.Name & ".txt", FileFormat:=xlTextWindows
Next
Set ws = Nothing
End If
wb.Close: Set wb = Nothing
End If
Next
xlApp.Quit
End Sub
Related
I am no expert when it comes to using VBA. However, I have a task to convert thousnds of files located in folders and sub folders. I have found online the below code and my question is: can the code be modified in a way that it can delete the old .xls files after conversion?
Public Sub test()
RenameFilesInFolders "M:\test\", True
MsgBox "Finished"
End Sub
Public Sub RenameFilesInFolders(path As String, Optional recurse As Boolean)
Dim fso As Object, fldr As Object
If Right(path, 1) <> "\" Then
path = path & "\"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(path)
renameFiles fldr, recurse
End Sub
Private Sub renameFiles(fldr As Object, recurse As Boolean)
Dim file As Object, subFldr As Object
For Each file In fldr.Files
changeFileExtension file
Next
If recurse And fldr.SubFolders.Count > 0 Then
For Each subFldr In fldr.SubFolders
renameFiles subFldr, recurse
Next
End If
End Sub
Private Sub changeFileExtension(file As Object)
Dim xlFile As Workbook
Dim strCurrentFileExt As String
Dim strNewFileExt As String
Dim strNewName As String
strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"
strNewName = file.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
Set xlFile = Workbooks.Open(file.path, , True)
strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
Application.DisplayAlerts = False
Select Case strNewFileExt
Case ".xlsx"
xlFile.SaveAs file.ParentFolder & "\" & strNewName, XlFileFormat.xlOpenXMLWorkbook
Case ".xlsm"
xlFile.SaveAs file.ParentFolder & "\" & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
End Select
xlFile.Close
Application.DisplayAlerts = True
End If
End Sub
Store path (called in your RenameFilesInFolders Sub) in a variable (for example PathToFile) and use this command : Kill PathToFile.
Afterwards you can even check if the file is deleted with this (if you enabled Microsoft Scripting Runtime) :
Dim FSO As FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim PathToFile As String
If (FSO.FileExists(PathToFile) Then 'If the file still exists
'Your code
End If
Set FSO = Nothing
I have a VBA macro that open files in a folder, download data from an add-in, save and close.
This runs fine, but after 10 or 15 files, it gets quite slow. I think it is because Excel still keep previously opened files in the memory. I knew this because I saw the already-opened-and-closed files on the left panel as in the photo below. (the photo is to show where the panel is, I know there is only one file opened with the sheets, but you know what I mean).
My question is: is there a line of code that refresh or clear this temporary memory?
Here is my code:
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Application.ScreenUpdating = False
StartTime = Timer
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Assign the folder to oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(myPath)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then GoTo ResetSettings
For Each oFile In oFolder.Files
'Set variable equal to opened workbook
myFile = oFile.Name
Set wb = Workbooks.Open(filename:=myPath & myFile)
Set cmd = Application.CommandBars("Cell").Controls("Refresh All")
cmd.Execute
DoEvents
'Ensure Workbook has opened before moving on to next line of code
wb.Close savechanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
Next 'oFile
SecondsElapsed = Timer - StartTime
MsgBox "This code ran successfully in " & SecondsElapsed
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
ResetSettings:
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
End Sub
What about add:
set cmd = nothing
before
wb.Close savechanges:=True
There is a known issue in Excel with closed Workbooks leaving data in Memory, which can only be cleared by closing and reopening Excel.
The below code uses a late-bound second instance of the Excel application, in an attempt to alleviate this issue; the second instance will be closed and reopened periodically (currently set to every 5 files).
Sub SomeName()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
'NEW CODE
Dim appXL AS Object, counterFiles AS Long
counterFiles = 0
Application.ScreenUpdating = False
StartTime = Timer
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Assign the folder to oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(myPath)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then GoTo ResetSettings
For Each oFile In oFolder.Files
'NEW CODE
If appXL Is Nothing Then Set appNewExcel = CreateObject("Excel.Application")
DoEvents
'Set variable equal to opened workbook
myFile = oFile.Name
Set wb = appNewExcel.Workbooks.Open(filename:=myPath & myFile)
'Update / Refresh workbook
wb.RefreshAll
appNewExcel.CalculateFullRebuild
DoEvents
'Ensure Workbook has opened before moving on to next line of code
wb.Save
DoEvents
wb.Close savechanges:=True
'Ensure Workbook has closed before moving on to next line of code
'NEW CODE
Set wb = Nothing
counterFiles = counterFiles+1
If counterFiles mod 5 = 0 Then
appNewExcel.Quit
Set appNewExcel = Nothing
End If
DoEvents
Next 'oFile
SecondsElapsed = Timer - StartTime
MsgBox "This code ran successfully in " & SecondsElapsed
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
ResetSettings:
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
End Sub
I would like to run a VBA macro named MyMacro, which is saved as MyMacro.bas for many excel files. I have the VBS code below, but it is not doing what I want. I would really appreciate if somebody could take a look at it.
I am using Excel 2013. The files are saved as .xls.
Thank you.
Const sRootFolder = "C:\Documents"
Const sExportedModule = "C:\Documents\MyMacro.bas"
Const sMacroName = "MyMacro"
Dim oFSO, oFDR, oFile ' File and Folder variables
Dim oExcel, oWB ' Excel variables (Application and Workbook)
Start
'------------------------------
Sub Start()
Initialize
ProcessFilesInFolder sRootFolder
Finish
End Sub
'------------------------------
Sub ProcessFilesInFolder(sFolder)
' Process the files in this folder
For Each oFile In oFSO.GetFolder(sFolder).Files
If IsExcelFile(oFile) Then ProcessExcelFile oFile.Path
Next
End Sub
'------------------------------
Sub Initialize()
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oExcel = CreateObject("Excel.Application")
End Sub
'------------------------------
Sub Finish()
oExcel.Quit
Set oExcel = Nothing
Set oFSO = Nothing
End Sub
'------------------------------
Function IsExcelFile(oFile)
IsExcelFile = (InStr(1, oFSO.GetExtensionName(oFile), "xls", vbTextCompare) > 0) And (Left(oFile.Name, 1) <> "~")
End Function
'------------------------------
Sub ProcessExcelFile(sFileName)
On Error Resume Next
wscript.echo "Processing file: " & sFileName ' Comment this unless using cscript in command prompt
Set oWB = oExcel.Workbooks.Open(sFileName)
oWB.VBProject.VBComponents.Import sExportedModule
oExcel.Run sMacroName
oWB.Save
oWB.Close
Set oWB = Nothing
End Sub
'------------------------------
Here is a vbs code for a single file which works:
Option Explicit
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Dim objWorkbook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Documents\test.xls", 0, True)
Set objWorkbook = xlApp.Workbooks.Open("C:\Documents\test.xls")
xlApp.Run "MyMacro"
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
I finally got it working:
Const sRootFolder = "C:\Documents"
Const sExportedModule = "C:\Documents\MyMacro.bas"
Const sMacroName = "Trip"
Dim oFSO, oFile ' File and Folder variables
Dim xlApp, xlBook, objWorkbook
Start
Sub Start()
Initialize
ProcessFilesInFolder sRootFolder
Finish
End Sub
Sub ProcessFilesInFolder(sFolder)
' Process the files in this folder
For Each oFile In oFSO.GetFolder(sFolder).Files
If IsExcelFile(oFile) Then ProcessExcelFile oFile.Path
Next
End Sub
Sub Initialize()
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set xlApp = CreateObject("Excel.Application")
End Sub
Sub Finish()
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Set oFSO = Nothing
End Sub
Function IsExcelFile(oFile)
IsExcelFile = (InStr(1, oFSO.GetExtensionName(oFile), "xls", vbTextCompare) > 0) And (Left(oFile.Name, 1) <> "~")
End Function
Sub ProcessExcelFile(sFileName)
wscript.echo "Processing file: " & sFileName ' Comment this unless using cscript in command prompt
Set xlBook = xlApp.Workbooks.Open(sFileName, 0, True)
Set objWorkbook = xlApp.Workbooks.Open(sFileName)
objWorkbook.VBProject.VBComponents.Import sExportedModule
xlApp.Run sMacroName
End Sub
Also, make sure that Trust access to the VBA project object model enabled. I certainly may be wrong, but the game changer here seems to be this piece:
Set objWorkbook = xlApp.Workbooks.Open(sFileName)
I am using following Script to Convert ".xls" file into ".xlsx". I want to change the file name of the newly converted file to a cell value found in cell "G9" of each worksheet. Please suggest the change in the script so file name could be changed to cell value at "G9".
Option Explicit
Dim oFSO, myFolder
Dim xlText
myFolder="C:\Users\khawar\Downloads"
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlText = 51 'Excel Text format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox ("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile in oFileList
If (Right(oFile.Name, 4) = ".xls") Then
Set oWB = oExcel.Workbooks.Open(oFile.Path)
oWB.ActiveSheet.Name = "Data"
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (myFolder & "\" & oWB.Name & ".xlsx", xlText)
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
I have a script that applies a macro to multiple excel spreadsheets. The code below opens specific file names and runs the script. I would love to modify this to run on all xls files within a specified folder. Any help would be great!
Dim objExcel, objWorkbook, xlModule, strCode
If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
OpenFile "C:\Billing\Import\IL\3.xls, ""
If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
OpenFile "C:\Billing\Import\IL\3.xls", ""
If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
OpenFile "C:\Billing\Import\IL\3.xls", ""
End If
On Error Resume Next
Set xlModule = Nothing
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing
On Error GoTo 0
'~~> Sub to open the file
Sub OpenFile(sFile, DestFile)
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = false
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open(sFile)
Set xlModule = objWorkbook.VBProject.VBComponents.Add(1)
strCode = _
"Sub MACRO()" & vbCr & _
'~~> My Macro Here
"End Sub"
xlModule.CodeModule.AddFromString strCode
objExcel.Run "MACRO"
objWorkbook.Close (False) '<~~ Change false to true in case you want to save changes
objExcel.Application.Quit
End Sub
'~~> Function to check if file exists
Function ReportFileStatus(filespec)
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
msg = "True"
Else
msg = "False"
End If
ReportFileStatus = msg
End Function
Thanks
The concept is pretty simple, given a folder path, process all files in it (or only certain files based on extension), and all files within it's subfolder. The simplest method is recursive subs and functions with some global variables in a single thread.
The next thing to consider is to Import .bas file instead of trying to add text to a new module. You need to export a working code from a Module first.
Below assumed the root folder to be "C:\Billing\Import", the exported module .bas file is "C:\Test\Module1.bas", and the Sub name you want to execute is "MACRO".
Const sRootFolder = "C:\Billing\Import"
Const sExportedModule = "C:\Test\Module1.bas"
Const sMacroName = "MACRO"
Dim oFSO, oFDR, oFile ' File and Folder variables
Dim oExcel, oWB ' Excel variables (Application and Workbook)
Start
'------------------------------
Sub Start()
Initialize
ProcessFilesInFolder sRootFolder
Finish
End Sub
'------------------------------
Sub ProcessFilesInFolder(sFolder)
' Process the files in this folder
For Each oFile In oFSO.GetFolder(sFolder).Files
If IsExcelFile(oFile) Then ProcessExcelFile oFile.Path
Next
' Recurse all sub-folders from this folder
For Each oFDR In oFSO.GetFolder(sFolder).SubFolders
ProcessFilesInFolder oFDR.Path
Next
End Sub
'------------------------------
Sub Initialize()
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oExcel = CreateObject("Excel.Application")
End Sub
'------------------------------
Sub Finish()
oExcel.Quit
Set oExcel = Nothing
Set oFSO = Nothing
End Sub
'------------------------------
Function IsExcelFile(oFile)
IsExcelFile = (InStr(1, oFSO.GetExtensionName(oFile), "xls", vbTextCompare) > 0) And (Left(oFile.Name, 1) <> "~")
End Function
'------------------------------
Sub ProcessExcelFile(sFileName)
On Error Resume Next
wscript.echo "Processing file: " & sFileName ' Comment this unless using cscript in command prompt
Set oWB = oExcel.Workbooks.Open(sFileName)
oWB.VBProject.VBComponents.Import sExportedModule
oExcel.Run sMacroName
oWB.Close
Set oWB = Nothing
End Sub
'------------------------------
Feel free to ask if you get stuck understanding the program flow.