Импортируйте несколько файлов .blst (похожи на .csv), чтобы преуспеть - PullRequest
1 голос
/ 31 марта 2019

Я хочу импортировать несколько файлов .blst на один лист и хочу разместить файлы .blst горизонтально на листе. Какой файл будет помещен в отдельный 23 столбец, например, первое место файла в столбце A1 - W1, а второй файл X1-AT1 continue ... n. Но мой код не может их открыть.

Этот код ниже является функцией "Преобразовать в букву"

Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
   Debug.Print ConvertToLetter & 1
End Function

Этот код ниже является функцией мастера импорта

Function import_wizard(xFileName, xAddress) As String

   With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


End Function

Этот код ниже является кнопкой для просмотра и импорта нескольких файлов .blst

Private Sub browseXML_Click()

    Dim xFileName As Variant
    Dim xAddress As String
    Dim countFile As Integer


    On Error GoTo ErrHandler

    xFileName = Application.GetOpenFilename(FileFilter:="blst Files,*.*", Title:="Select file", MultiSelect:=True)

    If IsArray(xFileName) Then
            'Msg = vbNewLine
        For i = LBound(xFileName) To UBound(xFileName)
            Msg = Msg & xFileName(i) & vbCrLf
            countFile = i + 23

            xAddress = ConvertToLetter(countFile) & "1"
            SplitterMark.TextBox1.Value = Msg
            Call import_wizard(xFileName, xAddress)

        'Debug.Print "X = " & xAddress
        Next i

    Else
        MsgBox "No files were selected."
        GoTo ExitHandler
    End If

ExitHandler:
ErrHandler:
End Sub

Когда я устал комментировать ' Call import_wizard(xFileName, xAddress) код может выбрать несколько файлов и может отображаться в пользовательском интерфейсе, но устал удалять комментарий Call import_wizard(xFileName, xAddress) может выбрать несколько файлов, но он показывает только последний файл из выбранного и не открывает их файл. Я не уверен, что это не ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress)) или нет. Может кто-нибудь, пожалуйста, предложить? Спасибо

1 Ответ

0 голосов
/ 31 марта 2019

Вам нужно "(i)", чтобы выбрать каждый отдельный файл в этой строке кода:

Call import_wizard(xFileName(i), ...

Вам не нужна функция "ConvertToLetter" для преобразования номера столбца в адрес.
Я предлагаю рассчитать следующий столбец импорта следующим образом:

...
Dim NextColumn As Long
For i = LBound(xFileName) To UBound(xFileName)
    NextColumn = (i - 1) * 23 + 1
    Call import_wizard(xFileName(i), NextColumn)
Next i
...

Ваша процедура импорта должна начинаться следующим образом:

Function import_wizard(ByVal xFileName as String, NextColumn as Long) As String
   With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, ActiveSheet.Cells(1, NextColumn))
       ...
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...