csv 将一组TXT文件转换为Excel工作簿，每个文件都作为新工作表,将excel文件保存到新文件夹

r1zhe5dt 于 2023-05-26 发布在其他

关注(0)|答案(1)|浏览(131)

将一组TXT文件转换为Excel工作簿，每个文件都作为新工作表。将excel文件保存到新文件夹。我试图建立一个txt文件转换工具在excel中。我只能一次手动转换一个文件。下面是我如何设想的过程1.）打开转换工具（excel文件）2.）选择转换按钮，打开文件资源管理器3.）选择所有文件进行转换（最多50 .TXT文件），这是一个简单的逗号分隔转换到列4.）生成新的excel文件与转换后的数据，每个文件一张5.）保存新的excel文件到指定的文件夹我已经看到了一些答案在这里关于如何做转换，我真的更坚持如何选择多个TXT文件，并转换成一个新的工作簿
我有下面的代码，它为一个单独的应用程序提供了类似的功能。该程序将多种文件类型转换为Excel格式。它允许一次选择多个文件，并将每个转换后的文件保存到一个新的工作簿中，所有文件都放在同一个文件夹中。我想我可以解决这个问题，但我对VBA不够熟悉，不知道要改变什么。

Sub test()

    Dim fd As Office.FileDialog
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Dim nFolder As String
    Dim nFileWithPath As String
    Dim nFile As String
    Dim extensionFileFile As String
    Dim nConvertedFile As String
    
    Dim folderIsOpen As Boolean
    folderIsOpen = False
    
    Dim message As String 'The user will see this message at the end of the conversion.
    message = ""
    
    Dim TestRunWith As String
    Dim waferDiameter As Integer 'this integer will allow the program to know if the tests comes from a 3-inches wafers or a 6-inches wafers.
    Dim targetVz As Integer 'this integer represent the target Vz. It can be 7V, 9V or 11V according to the test results.
    
    'Unprotect all useful sheets
    Sheets("Results-3-inch").Unprotect Password:="microchip"
    Sheets("Results-6-inch").Unprotect Password:="microchip"
    Sheets("Conversion").Unprotect Password:="microchip"
    Sheets("Conversion").Activate
        
    UserForm1.Show
    If (Sheets("Conversion").Range("TestRunWith").Value = Sheets("Conversion").Range("Tesectxt").Value) Then
        tester = "Tesectxt"
    Else
        If (Sheets("Conversion").Range("TestRunWith").Value = Sheets("Conversion").Range("TesecCsv").Value) Then
            tester = "TesecCsv"
        Else
            tester = "Fec"
        End If
    End If
  
  
    'Open the File Dialog to choose the files
    Set fd = Application.FileDialog(msoFileDialogOpen)
    fd.Title = "Select file(s)"
    fd.AllowMultiSelect = True 'Allow the user to select more than one file
    
    If fd.Show() Then 'If the user opens a file
    
        Application.ScreenUpdating = False 'Don't update the screen so that the user doesn't see the opening and closing windows
        
        For Each SelectedFile In fd.SelectedItems
            nFileWithPath = SelectedFile
            extensionFile = UCase(Right(nFileWithPath, Len(nFileWithPath) - InStrRev(nFileWithPath, ".")))
            
            If (extensionFile = "TXT" And tester = "Tesectxt") Or (extensionFile = "CSV" And tester = "TesecCsv") Or (extensionFile = "XLSX" And tester = "Fec") Then
                'If Len(Dir(nConvertedFile)) = 0 Then 'If the .xlsx file doesn't already exist
                
                ThisWorkbook.Sheets("Data").Cells.ClearContents
                
                'File name :
                nFile = Right(nFileWithPath, Len(nFileWithPath) - InStrRev(nFileWithPath, "\"))
                nPath = Left(nFileWithPath, Len(nFileWithPath) - Len(nFile))
                nFile = Left(nFile, InStrRev(nFile, ".") - 1)
                
                'COPY DATA
                Set wb = Workbooks.Open(nFileWithPath) 'Open the test file
                Set ws = wb.Worksheets(1)
                nFile = ws.Name
                Range("A1:L4000").Select 'Copy the data
                Selection.Copy
                    
                'PASTE DATA
                ThisWorkbook.Activate
                Sheets("Data").Activate
                Range("A1").PasteSpecial Paste:=xlPasteValues 'Paste the data in the "Data" sheet
                Cells(1, 16).Value = nFile
                    
                'The Sheets Result will be updated with the new data.
                If (Sheets("DataConverted").Range("QtTests").Value < 400) Then 'if the number of tests is less than 400"
                    waferDiameter = 3 'the data comes from a 3-inch wafer.
                Else
                    waferDiameter = 6
                End If
                
                targetVz = Sheets("DataConverted").Range("TargetVz").Value
                
                If (UCase(Left(nFile, 2)) = "F9") Or UCase((Left(nFile, 2)) = "F8") Then
                    nFolder = nPath & Left(nFile, 5) & "-" & targetVz & "V-" & waferDiameter & "inches\"
                Else
                    If (UCase(Left(nFile, 2)) = "F1") Then
                        nFolder = nPath & Left(nFile, 6) & "-" & targetVz & "V-" & waferDiameter & "inches\"
                    Else
                    nFolder = nPath & nFile & "-" & targetVz & "V-" & waferDiameter & "inches\"
                    End If
                End If
                
                If Len(Dir(nFolder & nFile & ".xlsx")) = 0 Then 'if the file doesn't already exist
                    If Len(Dir(nFolder, vbDirectory)) = O Then 'if the folder doesn't already exist
                        MkDir (nFolder) 'create the new folder
                    End If
                    
                    'COPY RESULTS
                    If waferDiameter = 3 Then
                        Sheets("Results-3-inch").Copy
                    Else
                        Sheets("Results-6-inch").Copy
                    End If
                    
                    'PASTE RESULTS
                    With ActiveSheet.UsedRange
                        .Copy
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                    End With 'Paste values and format in a new Workbook
                
                    'SAVE RESULTS
                    wb.Close
                    ActiveWorkbook.SaveAs Filename:=nFolder & nFile & ".xlsx"     'Save the new Workbook with the .csv file's name (.xlsx extension) in the created Folder
                    ActiveWorkbook.Close
                    Application.CutCopyMode = False 'Clear the clipboard so that no clipboard message appears on the user's screen
                    
                    Set objOFS = CreateObject("Scripting.FileSystemObject")
                    If (Len(Dir(nFolder & nFile & "-original." & extensionFile)) = 0) Then
                        objOFS.moveFile nFileWithPath, nFolder & nFile & "-original." & extensionFile
                    End If

                    message = message & "- Conversion of " & nFile & " (" & targetVz & "V, " & waferDiameter & " inches)." & Chr(13) & Chr(10)
                    
                Else
                    message = message & "-" & nFolder & nFile & ".xlsx" & " already exists." & Chr(13) & Chr(10)
                    Application.CutCopyMode = False 'Clear the clipboard so that no clipboard message appears on the user's screen
                    wb.Close
                End If
            Else
                MsgBox "ERROR: The file" & SelectedFile & " is incompatible with the tester " & tester
        End If
        Next SelectedFile
        
        If message = "" Then
            MsgBox "No file has been converted. Close this Message Box to continue.", , "End of Conversion"
            Exit Sub
        End If
        
        'OPEN THE FOLDER WITH THE CONVERTED FILE
        nFolder = Left(nFileWithPath, InStrRev(nFileWithPath, "\") - 1)
        Set oShell = CreateObject("Shell.Application")
        For Each Wnd In oShell.Windows
            If Wnd.Name = "File Explorer" Then
            ' The folder may have not exactly the same path ("P:\Folder" and "\\max\public\Folder" for example).
            ' We compare the last part of both path to see if our folder isn't already open.
                lenSecondPartPath = IIf(Len(Wnd.Document.Folder.Self.Path) < Len(nFolder), Len(Wnd.Document.Folder.Self.Path) / 2, Len(nFolder) / 2)
                If Right(Wnd.Document.Folder.Self.Path, lenSecondPartPath) = Right(nFolder, lenSecondPartPath) Then folderIsOpen = True
            End If
        Next Wnd
        If folderIsOpen = False Then
            Shell Environ("WINDIR") & "\explorer.exe " & nFolder, vbNormalNoFocus
        End If
        
        Sheets("Conversion").Activate
        Application.ScreenUpdating = True 'Update the screen
        
        message = message & Chr(13) & Chr(10) & "Close this Message Box to continue."
        MsgBox message, , "End of Conversion"
        
    End If
    Set fd = Nothing
    
    'Protect the Sheets.
    Sheets("Results-3-inch").Protect Password:="microchip"
    Sheets("Results-6-inch").Protect Password:="microchip"
    Sheets("Conversion").Protect Password:="microchip"
End Sub

Function CheckFileIsOpen(chkSumfile As String) As Boolean

    On Error Resume Next
    
    CheckFileIsOpen = (Workbooks(chkSumfile).Name = chkSumfile)
    
    On Error GoTo 0
    
End Function

csv

来源：https://stackoverflow.com/questions/76317548/convert-group-of-txt-files-to-excel-workbook-with-each-file-as-new-sheet-save-e

1条答案

按热度按时间

xeufq47z1#

也许是这个

Sub ReadFilesIntoActiveSheet()

Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range

' Get a FileSystem object
Set fso = New FileSystemObject

' get the directory you want
Set folder = fso.GetFolder("C:\Users\")

' set the starting point to write the data to
'Set cl = ActiveSheet.Cells(1, 1)
Dim sht As Worksheet
Dim LastRow As Long

Set sh = ActiveSheet

' Loop thru all files in the folder
For Each file In folder.Files
    ' Write file-name
    LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
    Range("A" & LastRow).Select
    ActiveCell = file.Name

    ' open the file
    Set txtFile = fso.OpenTextFile(file)

    col = 2
    Do While Not txtFile.AtEndOfStream
        dat = Application.Transpose(Application.Index(Split(txtFile.ReadLine, ","), 1, 0))
        sh.Cells(LastRow, col).Resize(UBound(dat), 1) = dat
        col = col + 1
    Loop

    ' Clean up
    txtFile.Close
    'Range(cl.Address).Offset(1, 0).Select
Next file

Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub

赞(0）回复(0）举报 2023-05-26

我来回答

csv 将一组TXT文件转换为Excel工作簿，每个文件都作为新工作表,将excel文件保存到新文件夹

1条答案

相关问题

热门标签

最新问答