I want to write a script which opens the two last modified files in a sharepoint folder called "Test". These are Excel CSV files, so they should open in Excel. This is what I came up with, it seems to work for a local folder, but not for Sharepoint.
Sub test()
Dim SummaryWB As Workbook
Dim FileSys, objFile, myFolder, c As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim strFilename, strFilename2
FolderName = ("https://sharepoint.com/sites/Team/Shared%20Documents/Test")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set myFolder = FileSys.GetFolder(FolderName)
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If InStr(1, objFile.Name, ".csv") > 0 Then
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename2 = strFilename
strFilename = objFile.Name
End If
End If
Next objFile
Set wb1 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename)
Set wb2 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename2)
End Sub
Related
I am new to VBA, I have pieced together the following code to convert all .xls files to .xlsx in a folder and delete old .xls files.
I ran it and it worked...now it does not. Now I get a Runtime error 53 'File not found', the code hangs at the Kill command after successfully saving the file. Any ideas?
Sub ConvertToXlsx()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
' Path must end in trailing backslash
strPath = "C:\Work Docs\Command and Control\Test\"
strFile = Dir(strPath & "*.xls")
Do While strFile <> ""
If Right(strFile, 3) = "xls" Then
Set wbk = Workbooks.Open(Filename:=strPath & strFile)
ActiveSheet.Name = "NewName"
wbk.SaveAs Filename:=strPath & strFile & "x", _
FileFormat:=xlOpenXMLWorkbook
wbk.Close SaveChanges:=False
If Right(strFile, 3) = "xls" Then
Kill strFile
End If
End If
strFile = Dir
Loop
End Sub
I cant test this currently so sorry if it doesn't work.
I always prefer to use the FileSystemObject to iterate files in folders.
Its creates the files as objects and opens you up to many useful attributes and methods etc.
First you need to
set reference to microsoft scripting runtime
as per this link https://www.automateexcel.com/vba/getfolder-getfile/
Then ...
Sub delete_xls_replace_with_xlsx()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fldr As Folder
Dim fl As File
Dim wbk As Workbook
'set the folder
Set fldr = fso.GetFolder("C:\Users\username\documents\folder")
'iterate the files in the folder
For Each fl In fldr.Files
'check if xls
If Right(fl.Path, 3) = "xls" Then
'open wb
Set wbk = Workbooks.Open(fl.Path)
' save with new ext
wbk.SaveAs Filename:=Replace(fl.Path, "xls", "xlsx"), FileFormat:=51
wbk.Close SaveChanges:=False
'here it will delete the file
fso.DeleteFile (fl.Path)
End If
Next fl
End Sub
I am trying to find a way to convert multiple excel workbooks to pdf. I have found a vba code but I want to convert only unhidden sheets from each workbook.
Thanks in advance!
Here is the code:
Sub BatchOpenMultiplePSTFiles()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim strWindowsFolder As String
'Select the specific Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Call ProcessFolders(strWindowsFolder)
'Open the windows folder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub
Sub ProcessFolders(strPath As String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim objExcelFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strPath)
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
Set objExcelFile = objFile
Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)
strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) -1)
objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strWorkbookName & ".pdf"
objWorkbook.Close False
End If
Next
'Process all folders and subfolders
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder In objFolder.SubFolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
ProcessFolders (objSubFolder.Path)
End If
Next
End If
End Sub
I have hundreds of XLS files I need converted to XLSX.
I found this old thread with the same title and the code provided converts the files to XLSX but corrupts them.
My understanding is, this code renames the file with the proper xlsx extension but does not change the file format.
I am under the impression I need to make the file format FileFormat:=51
I tried adding ", FileFormat:=51" to the name but that did not seem to work.
Any suggestions on how I can change the FileFormat to 51?
Thank you
Love you all
Sub ChangeFileFormat_V1()
Dim strCurrentFileExt As String
Dim strNewFileExt As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As File 'Object
Dim xlFile As Workbook
Dim strNewName As String
Dim strFolderPath As String
strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"
strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
If Right(strFolderPath, 1) <> "\" Then
strFolderPath = strFolderPath & "\"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strFolderPath)
For Each objFile In objFolder.Files
strNewName = objFile.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
Application.DisplayAlerts = False
objFile.Name = strNewName
Application.DisplayAlerts = True
End If
Next objFile
``ClearMemory:
strCurrentFileExt = vbNullString
strNewFileExt = vbNullString
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set xlFile = Nothing
strNewName = vbNullString
strFolderPath = vbNullString
End Sub
Like I mentioned in the comment, you cannot just change the extention and expect it to work. You are supposed to open the file and do a .SaveAs NewFilename,Fileformat for each one of them.
Is this what you are trying? (Untested)
Sub Sample()
Dim strFolderPath As String
Dim StrFile As String
Dim NewFilename As String
Dim wb As Workbook
'~~> Set your folder here
strFolderPath = "C:\Users\Scorpio\Desktop\New folder\"
'~~> Loop through all the xls files in the folder
StrFile = Dir(strFolderPath & "*.xls")
Do While Len(StrFile) > 0
'~~> Get file name without extension
NewFilename = Left(StrFile, (InStrRev(StrFile, ".", -1, vbTextCompare) - 1))
Set wb = Workbooks.Open(strFolderPath & StrFile)
wb.SaveAs NewFilename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
DoEvents
wb.Close (False)
StrFile = Dir
Loop
End Sub
I have a bunch of Excel-Workbooks in the old .xls format. I'd like to convert them to .xlsx using VBA. The following code accomplishes this task but it needs to open each workbook in order to save it again.
Dim wbk As Workbook
Set wbk = Workbooks.Open(filename:="C:\some\example\path\workbook.xls")
wbk.SaveAs filename:="C:\some\example\path\workbook.xlsx", _
FileFormat:=xlOpenXMLWorkbook, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
wbk.Close SaveChanges:=False
Is there another way to do this task without the need to open each workbook?
This is very time consuming with at least 30-100 workbooks.
Here is the piece of code to get what you are looking for:
Sub ChangeFileFormat()
Dim strCurrentFileExt As String
Dim strNewFileExt As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim xlFile As Workbook
Dim strNewName As String
Dim strFolderPath As String
strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"
strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
If Right(strFolderPath, 1) <> "\" Then
strFolderPath = strFolderPath & "\"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strFolderPath)
For Each objFile In objFolder.Files
strNewName = objFile.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
Set xlFile = Workbooks.Open(objFile.Path, , True)
strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
Application.DisplayAlerts = False
Select Case strNewFileExt
Case ".xlsx"
xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbook
Case ".xlsm"
xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
End Select
xlFile.Close
Application.DisplayAlerts = True
End If
Next objFile
ClearMemory:
strCurrentFileExt = vbNullString
strNewFileExt = vbNullString
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set xlFile = Nothing
strNewName = vbNullString
strFolderPath = vbNullString
End Sub
this is the link for XL file format : https://msdn.microsoft.com/en-us/library/office/ff198017.aspx
'-----------------------------------------
A bit Modification:
Check this code, i have only changed its extension name, but please check it with the compatibility... and let me know is it working for you...
Sub ChangeFileFormat_V1()
Dim strCurrentFileExt As String
Dim strNewFileExt As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As File 'Object
Dim xlFile As Workbook
Dim strNewName As String
Dim strFolderPath As String
strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"
strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
If Right(strFolderPath, 1) <> "\" Then
strFolderPath = strFolderPath & "\"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strFolderPath)
For Each objFile In objFolder.Files
strNewName = objFile.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
Application.DisplayAlerts = False
objFile.Name = strNewName
Application.DisplayAlerts = True
End If
Next objFile
ClearMemory:
strCurrentFileExt = vbNullString
strNewFileExt = vbNullString
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set xlFile = Nothing
strNewName = vbNullString
strFolderPath = vbNullString
End Sub
Im completely new to VBA. I'm trying to write macro what open latest file from folder and copy and past data from specific sheet. I need to copy data from file opened by VBA (latest file from folder) and copy data from one sheet to my current file (Expiry date sheet).
I don't know how to declare open file as workbook from where I want to copy data. Any advice?
Private Sub CommandButton1_Click()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Set Y = Workbooks("TEST")
MyPath = "C:\Users\e9\Desktop\Automatyczne sprawdzanie expiry date\New folder\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
End Sub
Below is code sample taken from various references ..
Find Last modified file
You have to add reference for the FileSystemObject .. FileSystemObject how to add reference
Tested by adding a ActiveX button to worksheet on destination file (Book2.xlsm). Change the path and also "Book2.xlsm" to your path and filename.
Dim sFldr As String
Dim fso As Scripting.FileSystemObject
Dim fsoFile As Scripting.File
Dim fsoFldr As Scripting.Folder
Dim dtNew As Date, sNew As String
Dim sFileName As String
Set fso = New Scripting.FileSystemObject
sFldr = "C:\Temp\stackoverflow\excel\"
Set fsoFldr = fso.GetFolder(sFldr)
For Each fsoFile In fsoFldr.Files
If fsoFile.DateLastModified > dtNew Then
sNew = fsoFile.Path
sFileName = fsoFile.Name
dtNew = fsoFile.DateLastModified
End If
Next fsoFile
Workbooks.Open Filename:=sNew
Sheets("Sheet1").Copy Before:=Workbooks("Book2.xlsm").Sheets(1)
Windows(sFileName).Activate
ActiveWindow.Close
Once the latest file is opened,
Sheets("x").Activate
ActiveSheet.Range("x:y").select
selection.copy
workbooks("x").activate
sheets("X").activate
activesheet.range("x").select
selection.paste
Replace the xs and ys with desired names/ranges.
afterward continue your loop