VBA to export dat files from each row of a workbook

[zinizaga]

Hi all, i need help writing a macro that copies specific data from each row of a workbook and puts it into a separate dat file for each row. So far i was able to write something up that only works for the first row(seconf beneath header). How can i modify this to export each row on a separate file - again, having some custom ordering applied same as i do below

Sample data:
[TABLE="width: 358"]
<tbody>[TR]
[TD]Project name[/TD]
[TD]Client[/TD]
[TD]First name[/TD]
[TD]Last name[/TD]
[TD]userid[/TD]
[/TR]
[TR]
[TD]JHGH[/TD]
[TD]Nike[/TD]
[TD]John[/TD]
[TD]Doe[/TD]
[TD]johnd[/TD]
[/TR]
[TR]
[TD]VBNM[/TD]
[TD]Coca Cola[/TD]
[TD]Jane[/TD]
[TD]Doe[/TD]
[TD]janed2[/TD]
[/TR]
</tbody>[/TABLE]

Option Explicit

Sub TEST()


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


Dim Fileout As Object, fPath As String


fPath = ThisWorkbook.Path & "\" & Data.Range("A2") & "-" & Format(Now, "MM.DD.YYYY") & ".dat"
Set Fileout = fso.CreateTextFile(fPath, True, True)




opStr = "SOME HARDCODED TEXT &" _
& Data.Range("A2") & "|" & Data.Range("B2") & "|" & Data.Range("C2") & "|" & Data.Range("D2")


Fileout.Write opStr


Fileout.Close


MsgBox "Done. File: " & fPath


End Sub

 

[zinizaga]

anyone

 

[John_w]

Try this:

Public Sub Create_Dat_Files()

    Dim r As Long, lastRow As Long
    Dim filePath As String
    
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
        For r = 2 To lastRow
            filePath = ThisWorkbook.Path & "\" & .Cells(r, "A").Value & "-" & Format(Now, "MM.DD.YYYY") & ".dat"
            Open filePath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , "SOME HARDCODED TEXT &" & .Cells(r, "A").Value & "|" & .Cells(r, "B").Value & "|" & .Cells(r, "C").Value & "|" & .Cells(r, "D").Value
            Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        Next
    End With
    
    MsgBox "Done"
    
End Sub

 

[Norie]

Based on the original code.

Sub TEST()
Dim rng As Range
Dim FSO As Object
Dim Fileout As Object
Dim fPath As String
Dim opStr As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set rng = Data.Range("A2")
    Do
        fPath = ThisWorkbook.Path & "c:\Test\" & rng.Value & "-" & Format(Now, "MM.DD.YYYY") & ".dat"
    
        Set Fileout = FSO.CreateTextFile(fPath, True, True)

        opStr = "SOME HARDCODED TEXT &" _
            & rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(, 2).Value & "|" & rng.Offset(, 3).Value

        Fileout.Write opStr
        
        Fileout.Close

        Set rng = rng.Offset(1)
        
    Loop Until rng.Value = ""

End Sub