将数据从Excel电子表格导出到CSV

ncgqoxb0  于 11个月前  发布在  其他
关注(0)|答案(1)|浏览(119)

来自VBA Macro to Export Data from Excel Spreadsheet to CSV的代码将保存当前工作表的副本作为.CSV格式的存档文件。我将其分配给一个按钮。无论按钮在哪个工作表上,它都会导出该工作表并相应地标记它。
我希望我也可以选择文件路径或直接提供文件路径,这样我就不必手动操作。

Sub Export_CSV()

    '***************************************************************************************
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overwritten
    '***************************************************************************************
 
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook

    '(1) either used range in active sheet..
    'ActiveWorkbook.ActiveSheet.UsedRange.Copy
    
    '(2) or alternatively, user selected input range:
    Dim rng As Range
    Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
    Application.ScreenUpdating = False
    rng.Copy

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = WB1.Path & "\" & MyFileName
    
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
    
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = True
End Sub

字符串

ut6juiuv

ut6juiuv1#

Dim myfolder As String   
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
        MsgBox "You did not select a folder"
        Exit Sub
    End If
    myfolder = .SelectedItems(1) 'Assign selected folder to myfolder
End With

字符串

相关问题