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

Posted 2023-05-07

【中文标题】打开/删除/替换然后保存到 CSV

【英文标题】：Open/Delete/Replace then save to CSV

【发布时间】：2013-06-06 19:09:44

【问题描述】：

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

示例代码，除了需要创建 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

【讨论】：

抱歉，您需要更多对象来支持“范围”和“选择”，我将在几分钟内更新示例。

嘿，谢谢它帮了很多忙！但现在它不让我运行它，因为 Selection.Replace.... 有什么想法吗？我将把我到目前为止所做的事情放在一边

@DarrenMB - VBScript 中非法的命名参数怎么办？

认为需要 "workbook.Columns("A:A").SELECT" 方法调用以允许发生替换。

@Ekkehard.Horner 是的，错过了一些。还在编辑。刚刚注意到 xlUP