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（）转换文件是我正在尝试更新的列表框，filepath是一个文本框，其中包含所选文本文件的文件路径。感谢任何帮助，谢谢！

Answer 1

我没有机会对此进行恰当的测试，但这可能更符合您的需求：

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

Answer 2

好的，所以花了一些时间研究它并且花了很多时间调试我终于搞清楚了所以我想我会发布我的结果以防其他人需要帮助这个

    Function PipeToTab(ByVal OriginalText As String) As String
'Runs though current line of text stored in original text'
 On Error GoTo error1
 Dim ThisString As String, NewString As String, a As Integer
 NewString = ""

For a = 1 To Len(OriginalText)
'checks to see if current char is white space and if it is removes it
    If Mid(OriginalText, a, 1) = " " Then
    'checks to see if current char is | and if it is changes it to char$(9) (tab)
    ElseIf Mid(OriginalText, a, 1) = "|" Then
        NewString = NewString & Chr$(9)
    Else
        NewString = NewString & Mid(OriginalText, a, 1)
    End If
Next
    PipeToTab = NewString
 Exit Function
error1:
MsgBox (Err.Description)

 End Function`

这是我想出的用于从文本文件中转换文本行的函数“|”标签以及删除任何额外的空白区域。

    `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

这是用于转换文本文件的按钮。我使用文本流和行阅读器，以便将文本文件的每一行发送到管道到标签功能。

如何将管道分隔文件转换为制表符分隔文件，并在列表框VBA中显示结果

2 个答案: