excel - 将 Excel 作为 csv 导出到另一个位置时出现问题，vba - 窗口 "blacks out"

Question

我在将 Excel 文档导出为 CSV 时遇到了一些问题。我得到了以下代码的帮助，但我得到的问题是文档“变黑”并且之后变得无响应。
我希望我的用户之后能够继续处理该文件。

 Sub ExportAsCSV()
Application.DisplayAlerts = False
Dim folderPath As String, csvFile As String
folderPath = "C:\test"
If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath
 csvFile = folderPath & "\" & Split(ActiveWorkbook.Name, ".")(0) & ".csv"

    

ActiveWorkbook.Save
ActiveWindow.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs FileName:=csvFile, FileFormat:=xlCSV

ActiveWorkbook.Close SaveChanges:=False

End If


End Sub

Answer 1

导出为 CSV(覆盖并保存)

调整常量部分中的两个值。

请注意，这将覆盖 .csv文件，如果它已经存在。

代码

Option Explicit

Sub ExportAsCSV()
    
    Const FolderPath As String = "C:\test"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
    End If
    
    Dim FilePath As String
    FilePath = FolderPath & "\" & Split(wb.Name, ".")(0)
    
    Application.ScreenUpdating = False ' Will reset after `End Sub`.
    wb.Save
    Application.DisplayAlerts = False ' Enables overwrite without dialog popup.
    wb.SaveAs Filename:=FilePath, FileFormat:=xlCSV
    Application.DisplayAlerts = True
    wb.Close SaveChanges:=False

End Sub

以下将导出事件工作表并保存并打开工作簿。现在您可以继续在其中工作。

导出工作表

Option Explicit

Sub ExportAsCSV()
    
    Const FolderPath As String = "C:\test"
    
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
    End If
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sName As String: sName = swb.ActiveSheet.Name
    
    Dim FilePath As String
    FilePath = FolderPath & "\" & Split(swb.Name, ".")(0)
    
    Application.ScreenUpdating = False
    
    swb.Save
    swb.ActiveSheet.Copy
    Dim dwb As Workbook: Set dwb = ActiveWorkbook
    Application.DisplayAlerts = False ' Overwrite without dialog popup.
    dwb.SaveAs Filename:=FilePath, FileFormat:=xlCSV
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False

    Application.ScreenUpdating = True
    
    MsgBox "Worksheet '" & sName & "' exported.", vbInformation, "Success"

End Sub