PDA

View Full Version : Create csv files for rows corresponding to each ID in excel using VBA



bhrigu
09-26-2018, 12:00 PM
Hi,

I am using Office 2003 and am trying to push MS Access data into different MS Excel tables by ID for a particular date (need users input in hopefully an UI front end). So If the ID is "23CLT" for a particular date, we have excel pull data from access and create a file saved in csv format. I am quiet stuck at the moment and don't know where to go from here. Any help would make a world of difference.

Thank you so much in advance.


Option Explicit


Sub Button_Click_Data()


'CLICK ON TOOLS, REFERENCES AND SELECT THE LATEST MICROSOFT ACTIVEX DATA OBJECTS LIBRARY'


Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer


Cells.Clear


'Database path info


DBFullName = "\\atac-pdars-t001\bwtrend\GOAROUND.MDB"


'Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset


' Filter Data
Source = "SELECT Trend.* FROM Trend WHERE (Trend.[ID]) In ('1DCA','23CLT','61DFW') and Date = "01-01-2018 09:33:12" ORDER BY (Trend.[id])"
'Source = "SELECT * Trend"


.Open Source:=Source, ActiveConnection:=Connection


MsgBox "The Query:" & vbNewLine & vbNewLine & Source


'Worksheets("Trend").Columns("A:Z").AutoFit


'Write field names


For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
Next

' Write recordset
Range("A2").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing


End Sub
Option Explicit


Sub Button_Click_Data()


'CLICK ON TOOLS, REFERENCES AND SELECT THE LATEST MICROSOFT ACTIVEX DATA OBJECTS LIBRARY'


Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer


Cells.Clear


'Database path info


DBFullName = "\\atac-pdars-t001\bwtrend\GOAROUND.MDB"


'Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset


' Filter Data
Source = "SELECT Trend.* FROM Trend WHERE (Trend.[Arrival Airport]) In ('DCA','CLT','DFW') ORDER BY (Trend.[Arrival Airport])"
'Source = "SELECT * Trend"


.Open Source:=Source, ActiveConnection:=Connection


MsgBox "The Query:" & vbNewLine & vbNewLine & Source


'Worksheets("Trend").Columns("A:Z").AutoFit


'Write field names


For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
Next

' Write recordset
Range("A2").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing


End Sub
Option Explicit


Sub Button_Click_Data()


'CLICK ON TOOLS, REFERENCES AND SELECT THE LATEST MICROSOFT ACTIVEX DATA OBJECTS LIBRARY'


Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer


Cells.Clear


'Database path info


DBFullName = "\\atac-pdars-t001\bwtrend\GOAROUND.MDB"


'Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset


' Filter Data
Source = "SELECT Trend.* FROM Trend WHERE (Trend.[Arrival Airport]) In ('DCA','CLT','DFW') ORDER BY (Trend.[Arrival Airport])"
'Source = "SELECT * Trend"


.Open Source:=Source, ActiveConnection:=Connection


MsgBox "The Query:" & vbNewLine & vbNewLine & Source


'Worksheets("Trend").Columns("A:Z").AutoFit


'Write field names


For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
Next

' Write recordset
Range("A2").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing


End Sub
Option Explicit


Sub Button_Click_Data()


'CLICK ON TOOLS, REFERENCES AND SELECT THE LATEST MICROSOFT ACTIVEX DATA OBJECTS LIBRARY'


Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer


Cells.Clear


'Database path info


DBFullName = "\\atac-pdars-t001\bwtrend\GOAROUND.MDB"


'Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset


' Filter Data
Source = "SELECT Trend.* FROM Trend WHERE (Trend.[Arrival Airport]) In ('DCA','CLT','DFW') ORDER BY (Trend.[Arrival Airport])"
'Source = "SELECT * Trend"


.Open Source:=Source, ActiveConnection:=Connection


MsgBox "The Query:" & vbNewLine & vbNewLine & Source


'Worksheets("Trend").Columns("A:Z").AutoFit


'Write field names


For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
Next

' Write recordset
Range("A2").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing


End Sub