Автоматизировать импорт файлов .txt в Excel VBA - PullRequest
0 голосов
/ 24 января 2020

Я пытаюсь автоматизировать создание отчетов, мне нужно скопировать / вставить данные из файлов .txt, которые находятся на том же ковре, для этого я использую окно, потому что использование пути неэффективно при использовании на других компьютерах. Ошибки, с которыми я сталкиваюсь:

  • При сохранении новой рабочей книги я использую .xlsx или .xls, потому что она выдает ошибку совместимости данных, а рабочая книга не загружается или формат неверный (формат и расширение файла «Мой файл» не совпадает. Файл может быть поврежден или не является безопасным. Не открывайте его, если не доверяете источнику ¿Хотите открыть его? ")
  • Я хочу тип данных всех ячеек, которые будут текстовыми, чтобы я мог преобразовать дату в дд / мм / гггг
  • Мне нужно удалить все пробелы в столбцах, чтобы я мог добавить начальные нули в два столбца.

Я перепробовал множество макросов, которые я сделал, но не могу исправить ошибки.

Вот последний код, который я сделал для автоматизации, я до сих пор изучение VBA.

Sub REP_DET_Report()

    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.txt*")
        Do While xFileName <> ""

            With Workbooks.Open(xFdItem & xFileName)


                Dim objRange1 As Range

                'Set up the ranges
                Set objRange1 = Range("A1:A1048576")

                'Do the first parse
                objRange1.TextToColumns _
        Destination:=Range("A1"), _
        FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), Array(3, xlTextFormat), Array(4, xlTextFormat), Array(5, xlTextFormat), Array(6, xlTextFormat), Array(7, xlTextFormat), Array(8, xlTextFormat), Array(9, xlTextFormat), Array(10, xlTextFormat)), _
        DataType:=xlDelimited, _
        Tab:=False, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=True, _
        OtherChar:="|"


                Dim IntialName As String
                Dim sFileSaveName As Variant
                IntialName = "Sample"
                sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, FileFilter:="Libro de Excel(*.xls), *.xls")

                If sFileSaveName <> False Then
                    ActiveWorkbook.SaveAs sFileSaveName
                End If

            End With
            xFileName = Dir
        Loop
    End If
End Sub

Также я создал другой код, чтобы я мог вставить .txt в ту же рабочую книгу, но в разные рабочие листы, проблема в том, что он изменяет первый файл, но остальные не т.

Sub REP_DET_Report()
On Error Resume Next
myBook = ActiveWorkbook.Name
Set nav = CreateObject("shell.application")
folder = nav.browseforfolder(0, "PICK FOLDER", 0, "c:\").items.Item.Path
ChDir folder & "\"
file = Dir("*.txt")
Do While file <> ""
Workbooks.OpenText file, origin:=xlWindows, startrow:=1, DataType:=xlDelimited


Dim objRange1 As Range

    'Set up the ranges
  Set objRange1 = Range("A1:A1048576")

    'Do the first parse
    objRange1.TextToColumns _
     Destination:=Range("A1"), _
     FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), Array(3, xlTextFormat), Array(4, xlTextFormat), Array(5, xlTextFormat), Array(6, xlTextFormat), Array(7, xlTextFormat), Array(8, xlTextFormat), Array(9, xlTextFormat), Array(10, xlTextFormat)), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      other:=True, _
      OtherChar:="|"

other = ActiveWorkbook.Name
ActiveSheet.Copy before:=Workbooks(myBook).Sheets(1)
Workbooks(other).Close False
file = Dir()
Loop
End Sub
´´´
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...