CODEWITHSUNDEEP
excelvbavba7
EngineerTrooper
EngineerTrooper

Reputation: 27

Txt file close around 10000 lines of input

I have written txt-files with excel and a macro in the past several times. I didn't hit 10000 lines or more. Never say Never...

My .csv file has over 87000 rows like that example "15k50,CityABC,56ab,CountryofCity,ID,Street". I use the Split() function in order to separate the values. The Macro formated and wrote the values as single lines to the txt file.

Around 9800 lines the txt-file closed... But why? I tried with Slepp() to make sure the print algho isn't overloaded or something else.

The counter 10000 is there because I want to make it easer to understand for you. If it goes over 10000 the problem is "solved".

Information txt-File format:

Shortcut, after several comments

Option Explicit

#If VBA7 Then
 Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub formattedToTxt()

Dim strArr() As String
Dim strB As String
Dim intC As Integer

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

strB = filePathExport & "\" & filenameExport & fileFormatExport
Set fso = fso.CreateTextFile(strB, True)

Do While counter <= 10000
    strArr = Split(ActiveCell.Value, ",")
    intC = CalcWhitespace(strArr(5), 40)
    fso.WriteLine ("#  " & strArr(0) & "  #  " & strArr(1) & "  # " & strArr(2) & " # " & strArr(3) & "  # " & strArr(4) & " # " & strArr(5) & Space(intC) & "#")
    ActiveCell.Offset(1, 0).Select
    If ((counter Mod 1000) = 0) Then
        Debug.Print ("Entry " & counter & " written")
    End If
    counter = counter + 1
Loop

End Sub

Function CalcWhitespace(rawStr As String, maxLen As Integer) As Integer
    CalcWhitespace = maxLen - Len(rawStr)
End Function

Any Idea?

Upvotes: 0

Views: 410

Answers (1)

EngineerTrooper
EngineerTrooper

Reputation: 27

Thanks to all helpful VBA people from the comments above. I cleaned up the code. The following snipped is the full solution.

The .csv table contains diffrent strings with diffrent length in each line. In the final solution the whitespaces are checked before. It is importend to know the max-Length strings at the data. To format the txt-file output readable.

Maybe, an other solution has a better performance, but that works well in my case.

Have a great day!

'Find max string length for each whitespace
counter = 0
ActiveSheet.Cells(2, 1).Select   'ignore Headlinedata, because diffrent format in compare to data
intC = (UBound(arrWhitespace) - LBound(arrWhitespace))
Do While ActiveCell.Value <> ""
    strArr = Split(ActiveCell.Value, ",")
    For counterTwo = 0 To intC
        If Len(strArr(counterTwo)) > arrWhitespace(counterTwo) Then arrWhitespace(counterTwo) = Len(strTempArr(counterTwo))
    Next counterTwo
    counter = counter + 1
    ActiveCell.Offset(1, 0).Select
    If ((counter Mod 1000) = 0) Then
        Debug.Print ("Entry " & counter & " checked")
    End If
Loop

'Print Body of txt-file
Do While ActiveCell.Value <> ""
    strArr = Split(ActiveCell.Value, ",")
        
    'build string for each line
    strB = ""
    strB = strB & "#  " & strArr(0) & "  #"
    intC = CalcWhitespace(strArr(1), arrWhitespace(1))
    strB = strB & "  " & strArr(1) & Space(intC) & "  #"
    intC = CalcWhitespace(strArr(2), arrWhitespace(2))
    strB = strB & " " & strArr(2) & Space(intC) & " #"
    intC = CalcWhitespace(strArr(3), arrWhitespace(3))
    strB = strB & " " & strArr(3) & Space(intC) & "  #"
    intC = CalcWhitespace(strArr(4), arrWhitespace(4))
    strB = strB & " " & strArr(4) & Space(intC) & " #"
    intC = CalcWhitespace(strArr(5), arrWhitespace(5))
    strB = strB & " " & strArr(5) & Space(intC) & "  #"
    fso.WriteLine (strB)
    ActiveCell.Offset(1, 0).Select
    If ((counter Mod 1000) = 0) Then
        Debug.Print ("Entry " & counter & " written")
    End If
    counter = counter + 1
Loop

Function CalcWhitespace(rawStr As String, maxLen As Integer) As Integer
    CalcWhitespace = maxLen - Len(rawStr)
End Function

Next time I will use minimal-reproducible-example to avoid .Select

Upvotes: 1

Related Questions