79362353

Date: 2025-01-16 16:26:54
Score: 0.5
Natty:
Report link

I finally managed to get something to work mashing Taller's code (Thank you so much for that) with some other online code and the code the initial macro maker did. It is not a pretty solution and required a lot of editing of later subs to account for non-numerical values in calculations but here is my code mash that somehow worked

Dim filepath As String
Dim file As String
Dim filename As String
Dim filemax As Integer
Dim filei As Integer   
Dim TextFile As Integer
Dim FileContent As String

 Private Sub Cmdpopulate_Click()
        filei = 0
        filepath = InputBox("Please enter file path to be imported") & "\"                                                                                        'asks user for the file path (the files should be named with integers sequentially)
        filemax = InputBox("How many files do you wish to import?")                                                                                                                 'asks user how many files to import, this sets a maximum number to cycle through
        Do While filei < filemax                                                                                                                                                    'begins the file import loop, starting at filei (initially 0) up to filemax (defined above)
            filei = filei + 1
            filename = filei & ".txt"                                                                                                                                               'filename is the current filei integer and the extention
            foffset = filei + 19
            TextFile_FindReplace                                                                                                                                                                  'import file sub routine (see below)
        Loop
        add_frames
        format_tables
        Sheet1.Cells(1, 1).Select
    '    cmdpopulate.Visible = False
    End Sub
    Sub TextFile_FindReplace()
    
        file = filepath & "\" & filename
      TextFile = FreeFile
        Open file For Input As TextFile
            FileContent = Input(LOF(TextFile), TextFile)
        Close TextFile
      
            FileContent = Replace(FileContent, "          ", " --")
            TextFile = FreeFile
        Open file For Output As TextFile
            Print #TextFile, FileContent
        Close TextFile
        imptxt
    End Sub
    
    Public Sub imptxt()
        Sheet2.Range("a4").CurrentRegion.Offset(500, 0).Resize(, 40).Clear                                                                                                          'clears the table
        With Sheet2.QueryTables.Add(Connection:= _
            "TEXT;" & filepath & filename, Destination:=Sheet2.Range("$A$4"))
            .Name = Sheet2.Range("b1").Value
            .TextFilePlatform = 874
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileOtherDelimiter = "?"
            .TextFileSpaceDelimiter = True
            .TextFileConsecutiveDelimiter = True
            .Refresh BackgroundQuery:=True
            .RefreshStyle = xlOverwriteCells
        End With                                                                                                                                                                    'opens file  filename (defined above) at filepath (defined above), delimites for '?' and overwrites any data in existing cells
        Sheet2.Range("a1") = filepath                                                                                                                                               'inserts filepath in cell a1, troubleshooting only
        Sheet2.Range("a2") = filename                                                                                                                                               'inserts filename in cell b2, troubleshooting only
      '  Sheet2.Select                                                                                                                                                                  'goes to the send subroutine to put data from the import table into the summary table
        TextFile_Restore
    End Sub
    Sub TextFile_Restore()
        file = filepath & "\" & filename
      TextFile = FreeFile
        Open file For Input As TextFile
            FileContent = Input(LOF(TextFile), TextFile)
        Close TextFile
      
            FileContent = Replace(FileContent, " --", "          ")     'changing the document back
            TextFile = FreeFile
        Open file For Output As TextFile
            Print #TextFile, FileContent
        Close TextFile
         If filei = 1 Then
            headers
        End If
        send
    End Sub

I hope it never breaks as I don't think I would be able to do it again.

Reasons:
  • Blacklisted phrase (0.5): Thank you
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Nightshade