Automate report making

[Zerrets]

I'm trying to automate a report making, i have to copy/paste data from .txt files that are in the same carpet, to do so i use a window because using the path is inefficient when using in other computers. Errors i encounter:

• When saving the new Workbook i use .xlsx or .xls because it throws me an error of data compatibility and the workbook doesn't load or the format is not correct (The format and the extension of the file "My FILE" don't match. The file maybe damaged or not be safe. Dont open it unless you trust the origin ¿ Would you like to open it ?")
• I want the data type of all the cells to be text so i can transform the date into dd/mm/yyyy
• I have to delete all the spaces that are in the columns so i can add leading zeros into two columns.

I've tried tons of macros i've made but i can't fix the errors.



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:="Book(*.xls), *.xls")

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

End With
xFileName = Dir
Loop
End If
End Sub

 

[Zerrets]

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

 

[Zerrets]

Also i made another code so i can paste the .txt in the same workbook but in different worksheets, the issue with this one is that it modifies the first file but the rest don't.

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