问题描述:

i have already been looking at different solutions and code for the past few hours but none have worked (newbie to VBA).

I receive files from another of our sites which uses Russian characters, i need to have these files imported to an existing spreadsheet under the last used row as well as have the data uses windows Cyrillic characters.

The existing Spreadsheet does have columns, do you know how i would need to format the data in order to get the data to import under the existing column headings.

The data is tabbed but does not currently have any headings above them.

I managed to find some code that works for the import but this places this in cell A1 to the sheet that has the macro not another sheet and without columns. Any help would be appreciated.

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

网友答案:

This is a small Add-In I use for importing CSVs. Maybe it will help you:

  • It starts to import the data at the current selected cell.
    This can be changed at this point: Destination:=ActiveCell).
  • Since your CSV data is in the same order than your existing Excel columns you don't need to change anything. Just import everything as text as in the code example.
  • About the Cyrillic charset: .TextFilePlatform = -535 says that Unicode charset is used. .TextFilePlatform = 855 (without a trailing minus) stands for OEM Cyrillic.

'=============================================== 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
相关阅读:
Top