时间戳

首页 > 解决方案 > 选择一个文件并复制到 Excel VBA 中的文件夹

excel - 选择一个文件并复制到 Excel VBA 中的文件夹

问题描述

我需要以下帮助：单击浏览后，我希望用户能够选择文件。所选文件的路径将显示在文本框中。他们选择文件后，我希望他们单击​​我的第二​​个浏览按钮并选择要将文件复制到的文件夹。第二个文本框将包含他们选择的文件夹的路径。在他们单击创建 CSV 按钮后，.csv 文件的路径将显示在第三个文本框中（此路径将是所选文件夹 + 带有时间戳的文件。我附上了我的文本框的图像。ExcelMacroVBA项目这是我的代码至今：

Sub CreateCSV_Click()
    
    Dim CamelotXl As Workbook
    Dim strFile As String
    Dim SelectedFolder As String
    Dim CSVFilePath As String
    
    '//  CSVFilePath = "C:\tmp\CamelotSL\Camelot_csv_export" & "_" & Format(DateTime.Now, "MMddyyyyhhmmss") & ".csv"
    SelectedFolder = Worksheets(1).txtCamelotfolder.Text
    strFile = Worksheets(1).txtCamelotExcelFile.Text
   
     CSVFilePath = SelectedFolder & "\" & strFile & "_" & Format(DateTime.Now, "MMddyyyyhhmmss") & ".csv"
     
    If strFile = "False" Then
        Exit Sub
    End If
    
    '// Select "Detail Attachment" worksheet
    Set CamelotXl = Workbooks.Open(strFile)
    CamelotXl.Sheets("Detail Attachment").Activate
            
    '// Delete first row
    CamelotXl.Sheets("Detail Attachment").Range("1:1").Delete Shift:=xlUp
    
    Dim LastRow As Long: LastRow = CamelotXl.Sheets("Detail Attachment").UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim LastCol As Long: LastCol = CamelotXl.Sheets("Detail Attachment").UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Dim i As Long, j As Long
    Dim cellContent As String
    Dim fieldSeperator As String
    Dim fileLine As String
    
    fieldSeperator = ","
    
    Close #1
    Open CSVFilePath For Output As #1
        
    
    With CamelotXl.Sheets("Detail Attachment")
    
        '// Add header row
        For j = 1 To LastCol
                    
            cellContent = CamelotXl.Sheets("Detail Attachment").Cells(1, j)
            fileLine = fileLine & Chr(34) & cellContent & Chr(34) & fieldSeperator
            
        Next j
        
        Print #1, fileLine
        fileLine = ""
        
        For i = 2 To LastRow
            For j = 1 To LastCol
                cellContent = CamelotXl.Sheets("Detail Attachment").Cells(i, j)
                
                '//
                '// Remove double quotes from the cell content so they do not
                '// interfere with the enclosing double quotes for the field
                '// that will be generated in the csv file.
                '//
                '// For example, if the cell content is A24-104 5/8-S", we remove
                '// the trailing " so we don't have an extra double quote after
                '// enclosing the field, i.e "A24-104 5/8-S""
                '//
                cellContent = Replace(cellContent, """", "")
                
                fileLine = fileLine & Chr(34) & cellContent & Chr(34) & fieldSeperator
            Next j
            
            Print #1, fileLine
            fileLine = ""
        Next i
        
        Close #1
    End With
                    
    CamelotXl.Close (False)
    
    Worksheets(1).txtCamelotCSV.Text = CSVFilePath
             
End Sub

标签： excelvba

解决方案

Worksheets(1).txtCamelotExcelFile.Text = Application.GetOpenFilename("Excel Files (.xls), .xlsx", , "Browse for your File & Import Range")

Worksheets(1).txtCamelotExcelFile.Text = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.csv), *.csv")

将 fso 调暗为对象

设置 fso = VBA.CreateObject("Scripting.FileSystemObject")

Worksheets(1).txtCamelotCSV.Text = txtCamelotExcelFile.Text & "_" & Format(DateTime.Now) & ".csv"

调用 fso.CopyFile(strFile, CSVFilePath, True)

推荐阅读