Question

我对VBA编码还很陌生，所以我做错了。这是我在网上找到的一些代码，已针对我的目的进行了修改。

我需要将4x文本文件导入同一工作簿。这些文本文件没有标题，因此我想将文本导入具有标题的其他现有工作表中。我拥有的代码可以很好地导入文本并分隔特殊字符，但是它会打开到新的电子表格中，我只能执行一次。

我需要一个对话框供用户选择文件，并在对话框中提示向用户指示要导入的文件。例如，第一个文件说“选择先前的SVCORPNS文件”，第二个文件说“选择先前的MODELS文件”，第三个文件说“选择当前SVCORPNS文件”，第四个文件说“选择当前MODELS文件”。分隔值为〜。

我需要一种循环选择4个文本文件的方法。我以后可以添加标题，因为无法导入到预先存在的工作表中。

我尝试了宏录制并使用了强大的查询功能，但这很棒，但是我不知道如何打开以更改对话框代码，以供用户选择文件。

Sub Macro11()
'
' Macro11 Macro
'
'Imports a text file
Dim vFileName

On Error GoTo ErrorHandle

 vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "select previous SVCORPNS file")

'If the user pressed "Cancel" or didn't select a text file, exit the procedure.
If vFileName = False Then
   GoTo BeforeExit
End If

'Switch off screen updating for speed.
Application.ScreenUpdating = False

'We now import the selected text file
Workbooks.OpenText Filename:=vFileName, _
    Origin:=xlMSDOS, StartRow:=2, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=True, OtherChar:="~~", _
    TrailingMinusNumbers:=False, Local:=True

'Just to show how we auto adjust the width of column A.
Columns("A:A").EntireColumn.AutoFit

BeforeExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:MsgBox Err.Description
Resume BeforeExit
'
End Sub

感谢您的帮助，谢谢。

Answer 1

好的，这是一个更“完整”的示例：

Sub Tester()

    Dim vFileName, wb As Workbook

    Set wb = ThisWorkbook 'for example

    'load a file
    vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
                                            "select previous SVCORPNS file")
    If Len(vFileName) > 0 Then
        PutDataFromTextFile wb.Sheets("SVCORPNS").Range("A2"), vFileName, "~"
    End If

    'load another file
    vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
                                            "select previous MODELS file")
    If Len(vFileName) > 0 Then
        PutDataFromTextFile wb.Sheets("MODELS").Range("A2"), vFileName, "~"
    End If


    'load more files to more places....

End Sub


'Read in a delimited file from "fPath", split each row on "delim", 
'      and put the content onto a sheet starting at "rngDest".
' ## Does not handle cases where a field value can contain the delimiter
'      such as for csv where there is "hello, world" as a quoted field value
Sub PutDataFromTextFile(rngDest As Range, fPath, delim As String)
    Dim i As Long, fnum As Integer
    Dim LineText As String, arr

    fnum = FreeFile
    i = 0
    Open fPath For Input As #fnum
    While Not EOF(fnum)
        Line Input #fnum, LineText
        arr = Split(CStr(LineText), delim)
        rngDest.Offset(i, 0).Resize(1, UBound(arr) + 1).Value = arr
        i = i + 1
    Wend
    Close #fnum
End Sub

Excel VBA-使用“〜”定界值将多个文本文件导入同一工作簿

1 个答案: