我有一个包含.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提供了一个出色的附加组件来完成此任务,电源查询。
它使您可以将每个文件加载到文件夹中,并大量处理。在这里,您可以简要介绍可以为您做什么。