文件保存为CSV格式iin excel vba

时间:2017-04-07 14:57:34

标签: excel vba csv ms-word powerpoint

我使用以下代码将活动工作表保存为CSV,但在该文件夹中找不到输出文件。代码有什么问题?

代码供您参考:

    Sub Save_CSV()

      Application.ScreenUpdating = False
      Application.DisplayAlerts = False

    SaveNAme = "INDENTED_BOM"
    SavePath = Dir("C:\Users\350153\Desktop\AUTOMATION (STRUCTURES)")

    Range("A1:D150").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select

    Selection.Copy

    Workbooks.Add
    With ActiveSheet.Range("A2")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With

    ActiveSheet.Columns("A:D").AutoFit

    ActiveWorkbook.SaveAs Filename:=SavePath & SaveNAme & ".csv" _
        , FileFormat:=xlCSVWindows, CreateBackup:=False

    ActiveWorkbook.Save
    ActiveWindow.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Task Finished", vbInformation, "Finished"

   End Sub

1 个答案:

答案 0 :(得分:0)

您可以在不复制/粘贴的情况下执行此操作,因为Worksheet对象具有SaveAs方法,因此无需执行此操作:

  1. 通过Workbooks.Add
  2. 创建新工作簿
  3. 从当前工作簿中复制单元格范围
  4. 将复制的选择从(1)
  5. 粘贴到新工作簿中
  6. 从(1)
  7. 保存新工作簿

    相反,你应该:

    1. 在工作表
    2. 上调用SaveAs方法
    3. 删除您在前一段代码
    4. 中无法复制的行(1-4)

      它看起来像这样,也被修改以确保文件不存在。如果文件已存在,则MsgBox会提醒您,然后程序将退出而不保存。

      Sub SaveAs_CSV()
      Dim SaveNAme$, SavePath$, csvFullName$
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      
          SaveNAme = Range("B2")
          SavePath = Range("B3")
          If Right(SavePath,1) <> Application.PathSeparator Then SavePath = SavePath & Application.PathSeparator
      
          csvFullName = savePath & SaveNAme & ".csv"
      
          If Dir(csvFullName) <> "" Then
              'File already exists, alert the user and exit procedure
              MsgBox csvFullname & " already exists! The file will not be saved as CSV.", vbInformation
              GoTo EarlyExit
          End If
      
          ActiveSheet.SaveAs Filename:=csvFullName _
              , FileFormat:=xlCSVWindows, CreateBackup:=False
          Rows("1:4").EntireRow.Delete
          Columns("A:D").AutoFit
          ActiveWindow.Close
      
      EarlyExit:
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      
      End Sub