Question

更新的代码:(宏不运行）

    Dim objExcel, objWorkbook, xlModule, strCode

If ReportFileStatus("C:\scripts\test1.xls") = "True" Then
    OpenFile "C:\scripts\test1.xls", "C:\scripts\test.xls"
End If

If ReportFileStatus("C:\scripts\test2.xls") = "True" Then
    OpenFile "C:\scripts\test2.xls", "C:\scripts\test1.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 = True
    objExcel.DisplayAlerts = False

    Set objWorkbook = objExcel.Workbooks.Open(sFile)
    Set xlModule = objWorkbook.VBProject.VBComponents.Add(1)

    strCode = _
        "Sub CreateFile()" & vbCr & _
        "    Columns(""A:A"").Select" & vbCr & _
        "    Selection.Delete Shift:=xlToLeft" & vbCr & _
        "    Rows(""1:8"").Select" & vbCr & _
        "    Selection.Delete Shift:=xlUp" & vbCr & _
        "    Columns(""E:E"").Select" & vbCr & _
        "    Selection.ClearContents" & vbCr & _
"FName = ActiveWorkbook.Name" & vbCr & _
"If Right(FName, 4) = "".xls"" Then" & vbCr & _
"FName = Mid(FName, 1, Len(FName) - 4)" & vbCr & _
"End If" & vbCr & _
"Columns(1).Insert Shift:=xlToRight" & vbCr & _
"For i = 1 To Range(""B65000"").End(xlUp).Row" & vbCr & _
"TempString = """ & vbCr & _
"For j = 2 To Range(""HA1"").End(xlToLeft).Column" & vbCr & _
"If j <> Range(""HA1"").End(xlToLeft).Column Then" & vbCr & _
"TempString = TempString & _" & vbCr & _
"Cells(i, j).Value & ""^""" & vbCr & _
"Else" & vbCr & _
"TempString = TempString & _" & vbCr & _
"Cells(i, j).Value" & vbCr & _
"End If" & vbCr & _
"Next" & vbCr & _
"Cells(i, 1).Value = TempString" & vbCr & _
"Next" & vbCr & _
"Columns(1).Select" & vbCr & _
"Selection.Copy" & vbCr & _
"Workbooks.Add" & vbCr & _
"Range(""A1"").Select" & vbCr & _
"ActiveSheet.Paste" & vbCr & _
"Application.CutCopyMode = False" & vbCr & _
        "    ChDir ""C:\RES_BILLING\Export""" & vbCr & _
        "    ActiveWorkbook.SaveAs Filename:=FName & "".txt"", FileFormat:=xlTextPrinter, Local:=True, CreateBackup:=False" & vbCr & _
        "    Application.WindowState = xlMinimized" & vbCr & _
        "    Application.WindowState = xlNormal" & vbCr & _
        "    Application.DisplayAlerts = False" & vbCr & _
"End Sub"

    xlModule.CodeModule.AddFromString strCode


    objWorkbook.Close (False)
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

原始问题：

我的目标是让VB脚本在多个Excel电子表格中运行宏。

这很好但我有一个问题。

有时某个月的工作表可能无法使用，这是故意的。

我想创建一个IF语句，说明如果excel文件不可用，请跳到下一个文件。

所以在这种情况下，如果test1.xls不可用，请将one移动到下一个文件。我希望有道理。感谢任何能指导我正确方向的人。编程不是我的强项。

Answer 1

根据我的意见，为什么不在打开文件之前检查文件是否存在？另外，为什么不创建一个程序来打开文件而不是复制它？

尝试此操作（已完成测试）

Dim objExcel, objWorkbook, xlModule, strCode

If ReportFileStatus("C:\scripts\test1.xls") = "True" Then
    OpenFile "C:\scripts\test1.xls", "C:\scripts\test.xls"
End If

If ReportFileStatus("C:\scripts\test2.xls") = "True" Then
    OpenFile "C:\scripts\test2.xls", "C:\scripts\test1.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 = True
    objExcel.DisplayAlerts = False

    Set objWorkbook = objExcel.Workbooks.Open(sFile)
    Set xlModule = objWorkbook.VBProject.VBComponents.Add(1)

    strCode = _
        "sub test()" & vbCr & _
        "   msgbox ""Inside the macro"" " & vbCr & _
        "end sub"

    xlModule.CodeModule.AddFromString strCode

    objWorkbook.SaveAs DestFile

    objExcel.Run "Test"

    objWorkbook.Close (False) '<~~ Change false to true in case you want to save changes
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

Answer 2

已经过测试

Dim objExcel

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
objExcel.DisplayAlerts = False

InsertCode "C:\scripts\test1.xls", "C:\scripts\test1_upd.xls"
InsertCode "C:\scripts\test2.xls", "C:\scripts\test2_upd.xls"

objExcel.Quit

Sub InsertCode(wbPath, newPath)
    Dim objWorkbook, xlmodule, strCode

    On Error Resume Next
    Set objWorkbook = objExcel.Workbooks.Open(wbPath)
    On Error GoTo 0

    If Not objWorkbook Is Nothing Then
        Set xlmodule = objWorkbook.VBProject.VBComponents.Add(1)
        strCode = _
            "sub test()" & vbCr & _
            "   msgbox ""Inside the macro"" " & vbCr & _
            "end sub"
        xlmodule.CodeModule.AddFromString strCode
        objWorkbook.SaveAs newPath
        objWorkbook.Close
    End If
End Sub

VB脚本If语句 - 打开Excel工作簿

2 个答案: