VBA Excel导入

在过去的几个小时里，我已经在研究不同的解决方案和代码，但没有一个有效（VBA新手）。 我从另一个使用俄语字符的网站接收文件，我需要将这些文件导入到上次使用的行下的现有电子表格中，并使数据使用windows西里尔字符

现有电子表格确实有列，您知道我需要如何格式化数据，以便在现有列标题下导入数据

数据是选项卡式的，但当前上面没有任何标题

我设法找到了一些用于导入的代码，但这会将其放在单元格A1中的工作表中，该工作表包含宏，而不是另一个工作表，并且没有列。任何帮助都将不胜感激

Sub DoThis()
Dim TxtArr() As String, I As Long
 'TxtArr = BrowseForFile("C:\Users\rjoss\Desktop\SVY")
TxtArr = Split(OpenMultipleFiles, vbCrLf)
For I = LBound(TxtArr, 1) To UBound(TxtArr, 1)
    Import_Extracts TxtArr(I)
Next
End Sub
Sub Import_Extracts(filename As String)
 '
Dim Tmp As String
Tmp = Replace(filename, ".txt", "")
Tmp = Mid(Tmp, InStrRev(Tmp, "\") + 1)
 '
Range("A50000").End(xlUp).Offset(1, 0).Select
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & filename _
    , Destination:=Range("A50000").End(xlUp).Offset(1, 0))
    .Name = Tmp
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileOtherDelimiter = "~"
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
ActiveCell.EntireRow.Delete
End Sub


 'code copied from here and modified to work
 'http://www.tek-tips.com/faqs.cfm?fid=4114
Function OpenMultipleFiles() As String
Dim Filter As String, Title As String, msg As String
Dim I As Integer, FilterIndex As Integer
Dim filename As Variant
 ' File filters
Filter = "Text Files (*.txt),*.txt"
 ' Set Dialog Caption
Title = "Select File(s) to Open"
 ' Select Start Drive & Path
ChDrive ("C")
 'ChDir ("c:\Files\Imports")
ChDir ("C:\Users\rjoss\Desktop\SVY")
With Application
     ' Set File Name Array to selected Files (allow multiple)
    filename = .GetOpenFilename(Filter, FilterIndex, Title, , True)
     ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
 ' Exit on Cancel
If Not IsArray(filename) Then
    MsgBox "No file was selected."
    Exit Function
End If
msg = Join(filename, vbCrLf)
OpenMultipleFiles = msg
End Function

这是一个用于导入CSV的小程序。也许它会帮助你：

• 它开始在当前选定的单元格中导入数据。
  这一点可以更改：

  Destination:=ActiveCell）

• 由于CSV数据的顺序与现有Excel列的顺序相同，因此无需更改任何内容。只需像代码示例中那样将所有内容作为文本导入即可
• 关于：

  .TextFilePlatform=-535

  表示使用Unicode字符集

  .TextFilePlatform=855

  （不带尾随减号）表示OEM西里尔文

---

---

文件中的数据与现有列的顺序相同，还是必须重新排列文件中的数据？您需要使用特定选项宏记录手动文本导入。@BAROWC它与文件中的数据的顺序相同，但文件中的一些数据是无用的，我们以拆分的方式获取文件，因此我得到了一个批处理文件，该文件合并了数据，但不删除无用的信息，我们只需要其中的某些部分，例如客户名称、客户id等。Peter L，谢谢你知道有什么资源可以帮到我，例如示例（当我看到它工作时，我更了解编码）。谢谢！你可以使用OLE DB文本文件驱动程序像查询sql表一样查询文本文件-请参阅@Ryan查看和

'=============================================== this code is placed in a new modul ==================================================================================
Function ImportCSV()                            'this function imports the CSV

    Dim ColumnsType() As Variant                'declares an empty zero-based array. This is the only variable which MUST be declared
    MyPath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")        'asks the user which CSV file should be imported
    If MyPath = False Then Exit Function        'if the user aborts the previous question, then exit the whole function

    ReDim ColumnsType(16383)                    'expand the array since excel 2007 and higher has 16384 columns. Excel 2003 is fine with that
    For i = 0 To 16383                          'start a loop with 16383 iterations
        ColumnsType(i) = 2                      'every column should be treated as text (=2)
    Next i                                      'repeat the loop and count up variable i

    If ActiveCell Is Nothing Then
        Workbooks.Add
        Application.Wait DateAdd("s", 1, Now)
        ActiveWorkbook.Windows(1).Caption = Dir(MyPath)
    End If

    With ActiveWorkbook.ActiveSheet.QueryTables.Add(Connection:="TEXT;" & MyPath, Destination:=ActiveCell)     'creates the query to import the CSV. All following lines are properties of this
        .PreserveFormatting = True              'older cell formats are preserved
        .RefreshStyle = xlOverwriteCells        'existing cells should be overwritten - otherwise an error can occur when too many columns are inserted!
        .AdjustColumnWidth = True               'adjust the width of all used columns automatically
        .TextFilePlatform = -535                'import with Unicode charset
        .TextFileParseType = xlDelimited        'CSV has to be a delimited one - only one delimiter can be true!
        .TextFileOtherDelimiter = Application.International(xlListSeparator)                                'uses system setting => EU countries = ';' and US = ','
        .TextFileColumnDataTypes = ColumnsType  'all columns should be treted as pure text
        .Refresh BackgroundQuery:=False         'this is neccesary so a second import can be done - otherwise the macro can only called once per excel instanz
    End With                                    'on this line excel finally starts the import process

    ActiveWorkbook.ActiveSheet.QueryTables(1).Delete  'deletes the query (not the data)

End Function                                    'we are finished