Я пытаюсь автоматизировать создание отчетов, мне нужно скопировать / вставить данные из файлов .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
´´´