excel batch export rows to csv vba

BatchExportRowsToCSV.vba

Sub BatchExportRowsToCSV()
    Dim Filename, Pathname As String
    Dim wb As Workbook

    Pathname = ActiveWorkbook.Path & "\source\"
    Filename = Dir(Pathname & "*.xlsm")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        ExcelRowsToCSV wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

Sub DoWork(wb As Workbook)
    With wb
        'Do your work here
        .Worksheets(1).Range("A1").Value = "Hello World!"
    End With
End Sub

Sub ExcelRowsToCSV(wb As Workbook)
    With wb
          Dim iPtr As Integer
          Dim sFileName As String
          Dim intFH As Integer
          Dim aRange As Range
          Dim iLastColumn As Integer
          Dim oCell As Range
          Dim iRec As Long
         
          Set aRange = Range("B1").CurrentRegion
        
          iLastColumn = aRange.Column + aRange.Columns.Count - 1
         
          iPtr = InStrRev(ActiveWorkbook.FullName, ".")
          sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".csv"
          If sFileName = "False" Then Exit Sub
         
          Close
          intFH = FreeFile()
          Open sFileName For Output As intFH
         
          iRec = 0
          For Each oCell In aRange
            If oCell.Column = iLastColumn Then
              Print #intFH, oCell.Value
              iRec = iRec + 1
            Else
              Print #intFH, oCell.Value; ",";
            End If
          Next oCell
         
          Close intFH
    End With
 
End Sub