Update on 19/9/2015: To address the issue raised, I split the sub into three sections.
- To copy the file from one place to another
- To convert (using save-as method) xls to xlsx. The file can be opened.
- vlookup the value and print it on designated cell.
I managed to get the first 2 tasks done, with the second task from the help: Batch convert .xls to .xlsx with VBA without opening the workbooks
However, the error pop up: subscript out of range when I run the
Previously:
Hi This is the first time for me to ask a question and I had tried my very best to adhere to the tips and guidelines given. Note: Assume the macro perform in a.xlsx
I wrote this macro to:
- Copy a file (abc.xls) from path A
- Paste the file (abc.xls) to path B
- Rename the file from abc.xls to abc.xlsx
- Perform vlookup to look for the value in abc.xlsx and return the value in a.xlsx 's designated cell.
Sub CopyFile()
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim i As Integer
Dim wbk As Workbook
' Get the number of times to loop from Cell D2
NumLoop = Cells(2, "D")
' Establish "For" loop to loop "NumLoop" number of times.
For i = 1 To NumLoop
' This is the file name, examle "LBF-010114.xls"
sFile = Sheets("Data Pointer").Cells(i + 2, "AG")
'This is the source file's path/location, example" D:\users\destop\A\"
sSFolder = Sheets("Data Pointer").Cells(i + 2, "AD")
'this is the destination file's path, example" D:\users\destop\B\"
sDFolder = Sheets("Data Pointer").Cells(i + 2, "AF")
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(sSFolder & sFile) Then
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
'Just a check point to see if the code executed until this point
Cells(i + 5, "E") = "File Exist"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
Next
End Sub
Sub ConvertAllFile()
'I refer to https://stackoverflow.com/questions/29167539/batch-convert-xls-to-xlsx-with-vba-without-opening-the-workbooks
'All credits go to them
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 = "D:\Users\COM_GSY.APLIFEISGREAT\Desktop\LBF Fund\"
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
Sub PrintNAV()
Dim i As Integer
Dim FilePath As String
Dim sFile As String
Dim FSO
NumLoop = Cells(2, "D")
For i = 1 To NumLoop
'Get the file name
sFile = Sheets("Data Pointer").Cells(i + 2, "AG")
'Set the file path
FilePath = "D:\Users\COM_GSY.APLIFEISGREAT\Desktop\LBF Fund\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FilePath & sFile) Then
Cells(i + 5, "B") = Application.WorksheetFunction.vLookUp(Sheets("Data Pointer").Cells(i + 2, "N"), Workbooks(FilePath & sFile).Sheets("Sheet1").Range("A1:L120"), 12, False)
End If
Next i
End Sub
I checked on some of the comments in the forum here, it was said that it is possible to perform vlookup for closed excel workbook so long it is xlsx format. Not sure how true is that.
Again, I would appreciate any comment to help up.