将.txt文件转换为.xlsx并删除不需要的行并正确格式化列



我有一个包含.txt文件的文件夹(它们包含phi,所以我无法上传.txt文件或一个没有PHI的示例,甚至没有任何图像(。我需要一个Excel宏,它将允许用户选择包含文件的文件夹,然后将.txt文件数据插入新的Excel工作簿中,将行适当地格式化和列,并最终将文件保存到同一文件夹中该来源被发现。到目前为止,除了行的格式化外,我已经有所有工作。截至目前,.txt数据已插入新的工作簿&工作表,但我似乎无法弄清楚如何摆脱我不需要的行,或如何适当地进行列的格式化。

再次,我无法上传.txt文件(或任何内容(,因为我为其工作的医疗保健组织即使我删除了所有PHI,也可以上传.txt文件(或任何内容(。

以下是我到目前为止创建的宏:

    Private Sub CommandButton2_Click()
    On Error GoTo err
    'Allow the user to choose the FOLDER where the TEXT file(s) are located
    'The resulting EXCEL file will be saved in the same location
        Dim FldrPath As String
        Dim fldr As FileDialog
        Dim fldrChosen As Integer
        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select a Folder containing the Text File(s)"
            .AllowMultiSelect = False
            .InitialFileName = "\FILELOCATION"
            fldrChosen = .Show
            If fldrChosen <> -1 Then
                MsgBox "You Chose to Cancel"
            Else
                FldrPath = .SelectedItems(1)
            End If
        End With

    If FldrPath <> "" Then
        'Make a new workbook
            Dim newWorkbook As Workbook
            Set newWorkbook = Workbooks.Add
        'Make worksheet1 of new workbook active
            newWorkbook.Worksheets(1).Activate

        'Completed files are saved in the chosen source file folder
               Dim CurrentFile As String: CurrentFile = Dir(FldrPath & "" & "*.txt")
               Dim strLine() As String
               Dim LineIndex As Long
               Application.ScreenUpdating = False
               Application.DisplayAlerts = False
               While CurrentFile <> vbNullString
                   'How many rows to place in Excel ABOVE the data we are inserting
                   LineIndex = 0
                   Close #1
                   Open FldrPath & "" & CurrentFile For Input As #1
                   While Not EOF(1)
                        'Adds number of rows below the inserted row of data
                        LineIndex = LineIndex + 1
                        ReDim Preserve strLine(1 To LineIndex)
                        Line Input #1, strLine(LineIndex)
                   Wend
                   Close #1
                   With ActiveSheet.Range("A1").Resize(LineIndex, 1)
                       .Value = WorksheetFunction.Transpose(strLine)
                       .TextToColumns Other:=True, OtherChar:="|"
                   End With
                   ActiveSheet.UsedRange.EntireColumn.AutoFit
                   ActiveSheet.Name = Replace(CurrentFile, ".txt", "")
                    ActiveWorkbook.SaveAs FldrPath & "" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
                   ActiveWorkbook.Close
                   CurrentFile = Dir
               Wend
               Application.DisplayAlerts = True
               Application.ScreenUpdating = True
    End If
    Done:
        Exit Sub
    err:
        MsgBox "The following ERROR Occurred:" & vbNewLine & err.Description
        ActiveWorkbook.Close

    End Sub

关于我如何将整个线删除从Excel中删除的任何想法?以及如何适当地格式化列?因此,我不会从.txt文件中获取3列,将所有被卡住的Excel文件中的1列塞入1列?

谢谢

我建议您不要重新发明轮子。Microsoft提供了一个出色的附加组件来完成此任务,电源查询。

它使您可以将每个文件加载到文件夹中,并大量处理。在这里,您可以简要介绍可以为您做什么。

最新更新