VB腳本如果聲明 - 打開Excel工作簿

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不可用，請將一個移動到下一個文件。我希望這是有道理的。感謝任何能引導我朝着正確方向發展的人。編程不是我的特長。

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