Dalboz · May 1, 2024 21:16
diff --git a/cargaVariables.bas b/cargaVariables.bas
 Sub SplitExcelFile()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim chunkSize As Long
    Dim outputFolder As String
    Dim outputFileName As String
    Dim totalValues As Long
    Dim chunkCounter As Long
    Dim chunkValues As Long
    Dim rowData As String
    Dim fileNum As Integer
    Dim headerWritten As Boolean

    ' Define the worksheet
    Set ws = ThisWorkbook.Sheets("Plantilla") ' Change "Sheet1" to your actual sheet name
   
    ' Define the last non-empty row in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    ' Define the total count of values excluding the header
    ' In the model the header rows can contain unpto 81 values including blanks
    totalValues = (lastRow - 5) * 81 ' Total values in data rows
   
    ' Define the chunk size based on the total count of values
    ' The SAP tcode doesn't  allow more than 999 rows in the plain txt file
    chunkSize = 996 ' Total chunk size including header
   
    ' Initialize chunk counter
    chunkCounter = 1
   
    ' Initialize file number for writing to text file
    fileNum = FreeFile
   
    ' Open new text file for the first chunk
    outputFileName = ThisWorkbook.Path & Application.PathSeparator & "piece" & chunkCounter & ".txt"
    Open outputFileName For Output As #fileNum
   
    ' Write header to the first file
    Dim headerData As Range
    Set headerData = ws.Rows("1:5")
    For Each headerRow In headerData.Rows
        For Each cell In headerRow.Cells
            If Not IsEmpty(cell.Value) Then
                Print #fileNum, cell.Value & vbTab; ' Append tab character after each value
                chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the header
            End If
        Next cell
        Print #fileNum, ' Print newline after header row values
    Next headerRow
    headerWritten = True
   
    ' Write data rows to text files beginning from row 6 and beyond
    For i = 6 To lastRow
        ' Calculate the number of values in the current row
        Dim rowValues As Long
        rowValues = Application.WorksheetFunction.CountA(ws.Rows(i))
       
        ' Check if adding this row exceeds the chunk size
        If chunkValues + rowValues > chunkSize Then
            ' Close the current text file
            Close #fileNum
           
            ' Reset chunk values for the next chunk
            chunkCounter = chunkCounter + 1
            chunkValues = 0
           
            ' Open new text file for the next chunk
            outputFileName = ThisWorkbook.Path & Application.PathSeparator & "piece" & chunkCounter & ".txt"
            fileNum = FreeFile
            Open outputFileName For Output As #fileNum
           
            ' Write header to the new file
            For Each headerRow In headerData.Rows
                For Each cell In headerRow.Cells
                    If Not IsEmpty(cell.Value) Then
                        Print #fileNum, cell.Value & vbTab; ' Append tab character after each value
                        chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the header
                    End If
                Next cell
                Print #fileNum, ' Print newline after header row values
            Next headerRow
            headerWritten = True
        End If
       
        ' Copy only the values from the row to the text file
        Dim valuesArray As Variant
        valuesArray = ws.Rows(i).Value
        Dim k As Long
        For k = 1 To UBound(valuesArray, 2)
            If Not IsEmpty(valuesArray(1, k)) Then
                Print #fileNum, valuesArray(1, k) & vbTab; ' Append tab character after each value
                chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the row
            End If
        Next k
        Print #fileNum, ' Print newline after row values
    Next i
   
    ' Close the last text file
    Close #fileNum
 End Sub
	Sub SplitExcelFile()
	Dim ws As Worksheet
	Dim lastRow As Long
	Dim i As Long
	Dim chunkSize As Long
	Dim outputFolder As String
	Dim outputFileName As String
	Dim totalValues As Long
	Dim chunkCounter As Long
	Dim chunkValues As Long
	Dim rowData As String
	Dim fileNum As Integer
	Dim headerWritten As Boolean

	' Define the worksheet
	Set ws = ThisWorkbook.Sheets("Plantilla") ' Change "Sheet1" to your actual sheet name

	' Define the last non-empty row in column A
	lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

	' Define the total count of values excluding the header
	' In the model the header rows can contain unpto 81 values including blanks
	totalValues = (lastRow - 5) * 81 ' Total values in data rows

	' Define the chunk size based on the total count of values
	' The SAP tcode doesn't allow more than 999 rows in the plain txt file
	chunkSize = 996 ' Total chunk size including header

	' Initialize chunk counter
	chunkCounter = 1

	' Initialize file number for writing to text file
	fileNum = FreeFile

	' Open new text file for the first chunk
	outputFileName = ThisWorkbook.Path & Application.PathSeparator & "piece" & chunkCounter & ".txt"
	Open outputFileName For Output As #fileNum

	' Write header to the first file
	Dim headerData As Range
	Set headerData = ws.Rows("1:5")
	For Each headerRow In headerData.Rows
	For Each cell In headerRow.Cells
	If Not IsEmpty(cell.Value) Then
	Print #fileNum, cell.Value & vbTab; ' Append tab character after each value
	chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the header
	End If
	Next cell
	Print #fileNum, ' Print newline after header row values
	Next headerRow
	headerWritten = True

	' Write data rows to text files beginning from row 6 and beyond
	For i = 6 To lastRow
	' Calculate the number of values in the current row
	Dim rowValues As Long
	rowValues = Application.WorksheetFunction.CountA(ws.Rows(i))

	' Check if adding this row exceeds the chunk size
	If chunkValues + rowValues > chunkSize Then
	' Close the current text file
	Close #fileNum

	' Reset chunk values for the next chunk
	chunkCounter = chunkCounter + 1
	chunkValues = 0

	' Open new text file for the next chunk
	outputFileName = ThisWorkbook.Path & Application.PathSeparator & "piece" & chunkCounter & ".txt"
	fileNum = FreeFile
	Open outputFileName For Output As #fileNum

	' Write header to the new file
	For Each headerRow In headerData.Rows
	For Each cell In headerRow.Cells
	If Not IsEmpty(cell.Value) Then
	Print #fileNum, cell.Value & vbTab; ' Append tab character after each value
	chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the header
	End If
	Next cell
	Print #fileNum, ' Print newline after header row values
	Next headerRow
	headerWritten = True
	End If

	' Copy only the values from the row to the text file
	Dim valuesArray As Variant
	valuesArray = ws.Rows(i).Value
	Dim k As Long
	For k = 1 To UBound(valuesArray, 2)
	If Not IsEmpty(valuesArray(1, k)) Then
	Print #fileNum, valuesArray(1, k) & vbTab; ' Append tab character after each value
	chunkValues = chunkValues + 1 ' Increment chunk values by 1 for each non-empty cell in the row
	End If
	Next k
	Print #fileNum, ' Print newline after row values
	Next i

	' Close the last text file
	Close #fileNum
	End Sub