How can the code be updated to be an append to the full dataset?
Not sure what you mean..
You want EVERY record in tables "GroupSharedUser" and "ResponsibleUser" in the CSV file?
I thought this would have been much easier than this..
Well, one way or another, you have to create and open the text file, write to it, then close it.
I wrote the code to create the CSV files "Old school" creating the queries in line.
Here is another version using saved queries (saves about 20 lines with the way I wrote the SQL):
Code:
Private Sub cmdCreateCSV_Click() ' old school using saved queries
Dim d As DAO.Database
Dim r As DAO.Recordset
Dim sSQL As String
Dim TF As Integer
Dim FileToWrite As String
Set d = CurrentDb
'GroupSharedUserMap
Set r = d.OpenRecordset("qryGroupSharedUserToCSV")
If Not r.BOF And Not r.EOF Then
r.MoveLast
r.MoveFirst
'open CSV file for writing
TF = FreeFile
FileToWrite = CurrentProject.Path & "\" & "GroupSharedUserMap.CSV"
Open FileToWrite For Output As #TF
Print #TF, "UserID,Adapter,UserGroup"
Do While Not r.EOF
Print #TF, r!UserID & "," & r!Adapter & "," & r!AribaGroup
r.MoveNext
Loop
Close #TF
r.Close
End If
' ResponsibleUser
Set r = d.OpenRecordset("qryResponsibleUserToCSV")
If Not r.BOF And Not r.EOF Then
r.MoveLast
r.MoveFirst
'open CSV file for writing
TF = FreeFile
FileToWrite = CurrentProject.Path & "\" & "ResponsibleUser.CSV"
Open FileToWrite For Output As #TF
Print #TF, "Group,UniqueName,PurchasingUnit,PasswordAdapter"
Do While Not r.EOF
Print #TF, r!AribaGroup & "," & r!UserID & "," & r!PurchasingUnit & "," & r!Adapter
r.MoveNext
Loop
Close #TF
r.Close
End If
'clean up
Set r = Nothing
Set d = Nothing
MsgBox "Done!" & vbNewLine & vbNewLine & "Saved in folder " & CurrentProject.Path
End Sub
And here is another version using the File System Object (approx the same number of lines as the version above):
Code:
Private Sub cmdCreateCSV_Click() 'using File Systen Object
Dim d As DAO.Database
Dim fs As Object
Dim r As DAO.Recordset
Dim a As Object
Set d = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
'GroupSharedUserMap
Set r = d.OpenRecordset("qryGroupSharedUserToCSV")
If Not r.BOF And Not r.EOF Then
r.MoveLast
r.MoveFirst
'open CSV file for writing
Set a = fs.CreateTextFile(CurrentProject.Path & "\" & "GroupSharedUserMap.CSV", True)
a.WriteLine ("UserID,Adapter,UserGroup")
Do While Not r.EOF
a.WriteLine r.Fields(0)
r.MoveNext
Loop
a.Close
r.Close
End If
' ResponsibleUser
Set r = d.OpenRecordset("qryResponsibleUserToCSV")
If Not r.BOF And Not r.EOF Then
r.MoveLast
r.MoveFirst
'open CSV file for writing
Set a = fs.CreateTextFile(CurrentProject.Path & "\" & "ResponsibleUser.CSV", True)
a.WriteLine ("Group,UniqueName,PurchasingUnit,PasswordAdapter")
Do While Not r.EOF
a.WriteLine r.Fields(0)
r.MoveNext
Loop
a.Close
r.Close
End If
'clean up
On Error Resume Next
Set a = Nothing
Set r = Nothing
Set fs = Nothing
Set d = Nothing
MsgBox "Done!" & vbNewLine & vbNewLine & "CSV files saved in folder " & CurrentProject.Path
End Sub
This version prints EVERY record to the CSV files..........