如何將管道分隔文件轉換爲製表符分隔文件並在列表框中顯示結果VBA

Question

因此，我很新，在訪問中使用vba，我無法使此代碼正常工作。它應該做的是採取一個選定的文本文件，並將原始文件讀入列表框中。然後有第二個按鈕，當按下按鈕時，將文本文件從管道分隔文件轉換爲製表符分隔文件，然後將更改後的文件顯示到新的列表框中。

Option Compare Database 
Option Explicit 


Function GetFilenameFromPath(ByVal strPath As String) As String 
' Returns the rightmost characters of a string upto but not including the rightmost '\' 
' e.g. 'c:\winnt\win.ini' returns 'win.ini' 

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then 
     GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1) 
    End If 
End Function 

Private Sub Command0_Click() 
Dim fdlg As Office.FileDialog 

    Dim pipe_file As Variant 
    Dim FileName As String 
    Dim fn As Integer 
    Dim varFile As Variant 
    Dim FilePath As String 

    Me.OrigFile.RowSource = "" 
    Me.ConvertFile.RowSource = "" 
    Me.FileName = "" 
    Me.FilePath = "" 
    FileName = "" 



    Set fdlg = Application.FileDialog(msoFileDialogFilePicker) 
    With fdlg 
     .AllowMultiSelect = False 
     .Title = "Select pipe delimited file" 
     .Filters.Clear 
     .Filters.Add "Text Files", "*.txt" 

     If .Show = True Then 
      For Each varFile In .SelectedItems 
       FileName = GetFilenameFromPath(varFile) 
       FilePath = varFile 
      Next varFile 
      Me.FileName = FileName 
      Me.FilePath = FilePath 

      fn = FreeFile 

      Open FileName For Input As #fn 
      Do While Not EOF(fn) 
       Line Input #fn, pipe_file 
       Me.OrigFile.AddItem pipe_file 
      Loop 

      Close #fn 
     Else 
      MsgBox "You clicked Cancel in the file dialog box." 
     End If 
    End With 
End Sub 

Private Sub Convert_File_Click() 
'ByVal OutputFile As String)' 
On Error GoTo error1 
Dim pipe_file As Variant 
Dim ThisString As String 
Dim NewString As String 
Dim A As Integer 
Dim InputFile As String 
InputFile = Me.FilePath 
Open InputFile For Input As #1 

Const FileName = "c:\outputfile.txt" 
Dim my_filenumber As Integer 
my_filenumber = FreeFile 
Open FileName For Output As #2 
'Open OutputFile For Output As #2' 

While Not EOF(1) 
NewString = "" 
Line Input #1, ThisString 
For A = 1 To Len(ThisString) 
If Mid(ThisString, A, 1) = "|" Then 
NewString = NewString & Chr$(9) 
Else 
NewString = NewString & Mid(ThisString, A, 1) 
End If 
Next 

Print #2, ThisString 
Wend 
Do While Not EOF(2) 
Line Input #2, pipe_file 
Me.ConvertFile.AddItem pipe_file 
Loop 
Close #2 
Close #1 
Exit Sub 
error1: 
Close #1 
Close #2 
End Sub 

這是我迄今爲止現在我的問題是關於第二個按鈕或Convert_File_Click（）convertfile是我試圖更新和文件路徑列表框持有文本文件的文件路徑的文本框是被選中。 任何幫助表示讚賞，謝謝！

Answer 1

好了，所以花了一些時間研究它和大量的時間調試後，我終於找到它了，所以我想我會後我的情況下，別人永遠結果需要幫助，這

​​3210

這是我想出的功能，將文本文件中的一行文本從「|」到標籤以及刪除任何額外的空白。

`Private Sub Convert_File_Click() 
    On Error GoTo error1 
    Dim pipe_file As Variant 
    Dim ThisString As String 
    Dim a As Integer 
    Dim rfs, rts, InputFile, wfs, wts, OutputFile As Object 
    Dim InputFileName, OutputFileName, OriginalText, updatedText As String 

    ' File initialization 
    'open the original source file and create the output file with the name desired from textbox. 
    InputFileName = Me.FilePath 'filepath is a textbox that holds the location 
    'and name of where you want the textfile to go 
     Set rfs = CreateObject("Scripting.FileSystemObject") 
     Set InputFile = rfs.GetFile(InputFileName) 


    'open the text streams 
     Set rts = InputFile.OpenAsTextStream(1, -2) 'Read 
     Set wts = OutputFile.OpenAsTextStream(8, -2) 'Append 

    'then put line into conversion function and get the updated text 
    'move onto the next line until EOF 

     While rts.AtEndofStream = False 
      OriginalText = rts.ReadLine 'read current line of file 
      If OriginalText <> Empty Then 
       updatedText = PipeToTab(OriginalText) 
       wts.WriteLine updatedText 'put updated text into newly created file(output file) 
      Else 
      End If 
     Wend` 
'Output file clean up 
    wts.Close 
'Input File clean up 
    rts.Close 


End If 
'clear out filestreams 
    Set OutputFile = Nothing 
    Set wfs = Nothing 
    Set wts = Nothing 
    Set InputFile = Nothing 
    Set rfs = Nothing 
    Set rts = Nothing 

Exit Sub 
error1: 
' File Clean up 
rts.Close 
Set InputFile = Nothing 
Set rfs = Nothing 
Set rts = Nothing 

'Output 
wts.Close 
Set OutputFile = Nothing 
Set wfs = Nothing 
Set wts = Nothing 
MsgBox (Err.Description) 
End Sub 

這裏是用於轉換文本文件的按鈕。我使用文本流和一個線閱讀器爲了發送文本文件的每一行到管道到標籤功能。

Answer 2

我還沒有機會恰當地測試，但是這可能是更多的在你在找什麼行：

Private Sub Convert_File_Click() 
    On Error GoTo error_hander 

    Dim pipe_file As Variant 
    Dim ThisString As String 
    Dim NewString As String 
    Dim InputFile As String 
    Dim inputFileNo As Integer 
    Dim outputFileNo As Integer 
    Dim inputFileNo2 As Integer 
    Const FileName = "c:\outputfile.txt" 

    InputFile = Me.FilePath 

    inputFileNo = FreeFile 
    Open InputFile For Input As #inputFileNo 

    outputFileNo = FreeFile 
    Open FileName For Output As #outputFileNo 


    While Not EOF(inputFileNo) 
     Line Input #inputFileNo, ThisString 
     'Nix the FOR LOOP and use the Replace command instead. Less code and easier to understand 
     Print #outputFileNo, Replace(ThisString, "|", vbTab) 
    Wend 
    Close #outputFileNo 

    inputFileNo2 = FreeFile 
    Open FileName For Input As #inputFileNo2 

    Do While Not EOF(inputFileNo2) 
     Line Input #inputFileNo2, pipe_file 
     Me.ConvertFile.AddItem pipe_file 
    Loop 

    GoTo convert_file_click_exit 
error_hander: 
    'Do some error handling here 

convert_file_click_exit: 
    Close #inputFileNo 
    Close #outputFileNo 
End Sub 

此外，不由得注意到你GetFilenameFromPath程序。考慮這個：

Public Function GetFilenameFromPath(ByVal strPath As String) As String 
' Returns the rightmost characters of a string upto but not including the rightmost '\' 
' e.g. 'c:\winnt\win.ini' returns 'win.ini' 

    'There's a couple of ways you could do this so it's not so cumbersome: 
    '1. The DIR command (will return the name of the file if it is a valid directory and file: 
    GetFilenameFromPath = Dir(strPath, vbNormal) 
    '  OR 
    '2. InstrRev 
    Dim iFilePositionStart As Integer 
    iFilePositionStart = InStrRev(strPath, "\", -1, vbTextCompare) 
    GetFilenameFromPath = Mid$(strPath, iFilePositionStart + 1) 


End Function