Question

我正在使用Excel宏为工作簿中的每个工作表创建.CSV-Files。如果我通过单击Developer-Tab中的Macro运行宏并从那里运行宏，这一切都正常。

如果我从Excel文件中的表单按钮运行宏，它会为每个工作表创建一个CSV文件，但没有内容。

这里是VBA代码：

    'This method generates CSV-Files for every Worksheet in a Workbook.
    Sub BtnGenerateCSV_click()

    Dim WS As Excel.Worksheet
    Dim SaveToDirectory As String
    Dim intResult As Integer

    On Error GoTo Heaven

    'Disable all for my script unnecessary things.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    'Opens a file dialog for choosing the destination folder
    intResult = Application.FileDialog(msoFileDialogFolderPicker).Show

    If intResult <> 0 Then
    'If a selection was made, the selected path is saved into this variable.
    SaveToDirectory = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = "Wegleitung" Or startsWith(WS.Name, "Hilfstabelle") Then
        'Do Nothing because these Worksheets are just helping tables and not used data.
        Else
            'Saving the Worksheet as a CSV to the chosen path with the name of the Worksheet.
            WS.SaveAs SaveToDirectory & WS.Name, xlCSV
        End If

    Next
    ThisWorkbook.Close
    End If

'Enable all these for my script unnecessary things.
Finally:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

'Error-Handling
Heaven:
    MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
        "Source: " & Err.Source & " " & vbCrLf & _
        "Number: " & Err.Number & " " & vbCrLf & _
        "Description: " & Err.Description & " " & vbCrLf
End Sub

'This mmethod checks if a String starts with a specific other String.
Public Function startsWith(str As String, prefix As String) As Boolean
    startsWith = Left(str, Len(prefix)) = prefix
End Function

我不确定这个问题的真正原因但是我认为它必须用这个方法做一些SaveAs，它太慢而无法完成它的任务并被某些东西打断。我认为这是因为它有足够的时间来创建文件但不填充数据。

我尝试在SaveAs之后使用方法DoEvents但这不起作用。此外，我试图禁用应用程序上的事件，我认为这也是中断SaveAs-Method的可能原因。

最后，我读了很多关于Stackoverflow的问题，解决了从Excel文件创建CSV文件的任务，但我没有找到这个问题的答案。我希望这不是重复，但请纠正我，如果是的话。

提前感谢您的帮助！

Answer 1

一些事情。

您可以实际使用startsWith(WS.Name, "Hilfstabelle")运算符代替Like。例如Like "Hilfstabelle*"。这样您就不需要使用单独的功能了。
您需要在Heaven:
试试下面提到的代码。我没有测试过。如果您遇到任何问题，请告诉我。

<强>代码：

Sub BtnGenerateCSV_click()
    Dim WS As Worksheet
    Dim SaveToDirectory As String
    Dim intResult As Integer

    On Error GoTo Heaven

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    intResult = Application.FileDialog(msoFileDialogFolderPicker).Show

    If intResult <> 0 Then
        SaveToDirectory = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

        For Each WS In ThisWorkbook.Worksheets
            If WS.Name = "Wegleitung" Or WS.Name Like "Hilfstabelle*" Then
            Else
                WS.Copy
                ActiveWorkbook.SaveAs Filename:=SaveToDirectory & WS.Name & ".csv", FileFormat:=xlCSV
                ActiveWorkbook.Close savechanges:=False
            End If
        Next
    End If
Finally:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

    MsgBox "Done"
    Exit Sub
Heaven:
    MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
    "Source: " & Err.Source & " " & vbCrLf & _
    "Number: " & Err.Number & " " & vbCrLf & _
    "Description: " & Err.Description & " " & vbCrLf

    Resume Finally
End Sub

如果按钮单击

1 个答案: