0

我有 VBA 代码,可以打开文件、删除和替换某些内容,然后将其保存到 CSV 文件中。我打开了一个新的 Excel 工作簿并记录了上面提到的所有步骤。然后我把它保存到一个 .xlsm 文件中,所以当它被点击时它就可以完成它的工作。

但是,我想制作一个可以做同样事情的 VBScript。基本上有一个 VBScript 将打开 .xls 文件,清理它,然后将其保存到可以在 Excel 中打开的 .csv 文件中。

这是我的VBA:

Private Sub Workbook_Open()
 ChDir "C:\_deletelater\xls"
 Workbooks.OpenText filename:="C:\_deletelater\xls\traxreport.xls", Origin:= _
     437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
     ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
     , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
     TrailingMinusNumbers:=True
Range("A1:AD18").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Replace What:="DYN", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="WOO", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="MIS", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="BAS", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="BAR", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Selection.Replace What:="DLC", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
 Selection.Replace What:="SYN", Replacement:="", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False
 ActiveWorkbook.SaveAs filename:="C:\_deletelater\xls\traxreport.csv", _
     FileFormat:=xlCSV, CreateBackup:=False
 ActiveWorkbook.Save
If ThisWorkbook.Saved = False Then
   ThisWorkbook.Save
End If
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

ActiveWindow.Close

End Sub
4

1 回答 1

2

示例代码,除了您需要创建 Excel 在宏编辑器中提供的缺失对象外,几乎所有代码都可以正常工作。

这是将被放入 VBS 文件的代码的基础。

    dim Application : Set Application = CreateObject("Excel.Application")
Application.Visible=true ' OPTIONAL debug line to show excel
Application.DisplayAlerts = False ' MOVED should happen at start to prevent msgboxes.
dim Workbooks : Set Workbooks= Application.Workbooks ' to support direct calls
dim Selection ' needs to be set after each change it appears

' alter the next line to open your work book (return value from "OpenText")
' instead of to add a new one (was for my test)
dim WorkBook : Set Workbook = Workbooks.add()
dim sheet : Set sheet=Workbook.sheets(1) ' ADDED! first work sheet in the book.

msgbox "Just a msg to pause execution, remove this"

' your cremaining code here from your question ...
' Replace all "Range(" calls with "Workbook.Range("
' Replace "ActiveWorkbook" with "Workbook" to be more specific
' You will also need to translate all the constants such as 
' "xlDelimited" into there equivalent numerical values which 
' you can see in the object browser in excel's VBA Editor.

Application.Quit

下面提出的完整宏代码...

dim Application : Set Application = CreateObject("Excel.Application")
Application.Visible=true 
Application.DisplayAlerts = False ' MOVED should happen at start to prevent msgboxes.
dim Workbooks : Set Workbooks= Application.Workbooks
dim Selection ' set later (after each selection)

dim WorkBook : Set Workbook = Workbooks.add("C:\_deletelater\xls\traxreport.xls")
dim sheet : Set sheet=Workbook.sheets(1) ' first work sheet in the book.

sheet.Range("A1:AD18").Select                          ' CHANGED!
Set Selection = Application.Selection ' COPIED / REAPPLIED
Selection.Delete -4162 ' xlUp = -4162
sheet.Columns("A:A").Select ' added ".Select"              ' CHANGED!
Set Selection = Application.Selection ' COPIED / REAPPLIED
Selection.Replace "DYN", "", 2, 1, False, False, False
Selection.Replace "WOO", "", 2, 1, False, False, False
Selection.Replace "MIS", "", 2, 1, False, False, False
Selection.Replace "BAS", "", 2, 1, False, False, False
Selection.Replace "BAR", "", 2, 1, False, False, False
Selection.Replace "DLC", "", 2, 1, False, False, False
Selection.Replace "SYN", "", 2, 1, False, False, False
WorkBook.SaveAs "C:\_deletelater\xls\traxreport.csv", 6, False
Workbook.Save     ' xlCSV = 6
If Workbook.Saved = False Then
    Workbook.Save
End If
Workbook.Close
Application.DisplayAlerts = True
Application.Quit
于 2013-06-06T19:16:32.073 回答