Question

2015年9月19日更新：为了解决所提出的问题，我将该分为三个部分。

将文件从一个地方复制到另一个地方
要将xls转换为xlsx（使用另存为方法）。该文件可以打开。
vlookup该值并将其打印在指定的单元格上。

我设法完成了前两个任务，第二个任务来自帮助： Batch convert .xls to .xlsx with VBA without opening the workbooks

然而，当我运行

此前：

嗨这是我第一次提出问题而且我已尽力遵守给出的提示和指南。注意：假设宏在a.xlsx中执行

我把这个宏写成：

从路径A
将文件（abc.xls）粘贴到路径B
将文件从abc.xls重命名为abc.xlsx
执行vlookup以查找abc.xlsx中的值，并返回a.xlsx指定单元格中的值。

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

我查看了论坛中的一些评论，据说有可能为封闭的excel工作簿执行vlookup，只要它是xlsx格式。不确定那是多么真实。

同样，我会感谢任何评论来帮助。

Answer 1

Workbooks Collection是＆＃34;当前在Microsoft Excel应用程序中打开的所有工作簿对象的集合。＆＃34; 。它不包括硬盘上没有打开的工作簿。

如果您绝对决定访问已关闭的工作簿，请将该公式写入工作表单元格以处理未打开的工作簿的桥梁。通过在打开的工作表上评估本机工作表公式，您不必打开外部工作簿。您可以通过将公式恢复为其返回值来删除公式。

dim extVLOOKUP as string
If FSO.FileExists(FilePath & sFile) Then
    With Sheets("Data Pointer")
        extVLOOKUP = "=VLOOKUP(""" & .Cells(i + 2, "N") & """, '" & FilePath & "[" & sFile & "]Sheet1'!$A:$L, 12, FALSE)"
        'Debug.Print extVLOOKUP  '<~~ uncomment to check the formula
        '.Cells(i + 5, "B") = Application.Evaluate(extVLOOKUP)
        .Cells(i + 5, "B").Formula = extVLOOKUP
        .Cells(i + 5, "B") = .Cells(i + 5, "B").Value
    End With
End If

我已经从Sheets中包含了值（＆＃34;数据指针＆＃34;）。引号中的单元格（i + 2，＆＃34; N＆＃34;）就像文本值一样在工作表公式中用引号括起来。如果是数字，则可以（并且可能应该）删除引号。

Vlookup：Object不支持此属性或方法

1 个答案: