VB脚本如果语句 – 打开Excel工作簿
更新的代码:(macros不运行）
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电子表格中运行一个macros。
这很好，但我有一个问题。
有时一个工作表可能不适用于给定的月份，这是故意的。
我想创build一个IF语句，说如果Excel文件不可用跳到下一个文件。
所以在这种情况下，如果test1.xls不可用，请将其移动到下一个文件。 我希望这是有道理的。 感谢任何能引导我走向正确的人。 编程不是我的特长。
继续我的意见为什么不打开之前检查文件是否存在？ 另外，为什么不创build一个程序来打开文件，而不是重复它？
试试这个（ TRIED AND TESTED ）
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
尝试和testing
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