将数据从文本文件复制到Excel工作簿

Currently i am able to import text files into excel using vba. But, i can't figure out how to copy the data from the text file into current workbook. Everytime i run the program, it opens a new workbook for every text file.

目前我可以使用vba将文本文件导入excel。但是,我无法弄清楚如何将文本文件中的数据复制到当前工作簿中。每次运行程序时,它都会为每个文本文件打开一个新的工作簿。

Sub CopyData()

    Dim fileDialog As fileDialog
    Dim strPathFile As String
    Dim strFileName As String
    Dim strPath As String
    Dim dialogTitle As String
    Dim wbSource As Workbook
    Dim rngToCopy As Range
    Dim rngRow As Range
    Dim rngDestin As Range
    Dim lngRowsCopied As Long


    dialogTitle = "Navigate to and select required file."
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .InitialFileName = "C:\Users\User\Documents"
        .AllowMultiSelect = True
        .Filters.Clear
        .Title = dialogTitle



        If .Show = False Then
            MsgBox "File not selected to import. Process Terminated"
            Exit Sub
        End If
        strPathFile = .SelectedItems(1)
    End With

     Workbooks.OpenText Filename:=strPathFile, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True




    Set fileDialog = Nothing
    Set rngRow = Nothing
    Set rngToCopy = Nothing
    Set wbSource = Nothing
    Set rngDestin = Nothing

    MsgBox "The data is copied"

End Sub

1 个解决方案

#1

Although Siddart provided you a link, you can also try below. i just added a few fixes to somehow help you get you what you want.

虽然Siddart为您提供了链接,但您也可以尝试下面的链接。我刚刚添加了一些修复程序以某种方式帮助您获得所需内容。

Edit2:

Sub CopyData()

Dim fileDia As FileDialog
Dim i As Integer
Dim done As Boolean
Dim strpathfile As String, filename As String

'--> initialize variables here
i = 1
done = False

Set fileDia = Application.FileDialog(msoFileDialogFilePicker)
With fileDia
    .InitialFileName = "C:\Users\" & Environ$("username") & "\Documents"
    .AllowMultiSelect = True
    .Filters.Clear
    .title = "Navigate to and select required file."
    If .Show = False Then
        MsgBox "File not selected to import. Process Terminated"
        Exit Sub
    End If
    '--> you need to iterate to the files selected, open and dump each in your current wb
    Do While Not done
        On Error Resume Next
        strpathfile = .SelectedItems(i)
        On Error GoTo 0

        If strpathfile = "" Then
            done = True
        Else
            filename = Mid(strpathfile, InStrRev(strpathfile, "\") + 1, Len(strpathfile) - (InStrRev(strpathfile, "\") + 4))
            '--> I added this because the maximum lengh of sheet name is 31.
            '--> It will throw error if you exceed 31 characters.
            If Len(filename) > 31 Then filename = Left(filename, 26)
            '--> use the transfer sub here, take note of the new ByVal argument
            Transfer strpathfile, filename
            'Debug.Print filename
            strpathfile = ""
            i = i + 1
        End If
    Loop
End With

Set fileDia = Nothing

End Sub

Supporting Sub (Edit2):

支持Sub(Edit2):

Sub Transfer(mySource As String, wsName As String)

Dim wbSource As Workbook
Dim wsDestin As Worksheet
Dim lrow As Long

Set wsDestin = ThisWorkbook.Sheets.Add(, ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Add the worksheet at the end
On Error Resume Next
wsDestin.Name = wsName 'set the name
On Error GoTo 0

Application.DisplayAlerts = False
If InStr(wsDestin.Name, "Sheet") <> 0 Then wsDestin.Delete: Exit Sub

Workbooks.OpenText filename:=mySource, _
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True

Set wbSource = ActiveWorkbook

With wsDestin
    '--> get the last row of your destination sheet, i assumed you want Column A
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    '--> not comfortable in UsedRange but this should work, else define your range.
    '--> i can't because, i can't see your actual data
    wbSource.Sheets(1).UsedRange.Copy .Range("A" & lrow).Offset(1, 0)
    wbSource.Close False
End With
Application.DisplayAlerts = True

End Sub

Hope this is somewhat close to what you need.
Already tested and is working fine.
But i'm not sure if you agree on how i put a unique identifier to your sheet name.
I've chosen sheets current count.
Change that part to what ever you want.
This now ignores the file if it is already loaded.

希望这有点接近你的需要。已经过测试,工作正常。但我不确定您是否同意我如何为您的工作表名称添加唯一标识符。我选择了床单当前计数。将该部分更改为您想要的任何部分。现在,如果文件已经加载,则忽略该文件。

#1