打开/删除/替换然后保存为CSV

时间:2013-06-06 19:09:45

标签: excel vbscript save

我有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

1 个答案:

答案 0 :(得分: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