Suppose you have database in Access and you want to create CSV file that includes customer's
information and order detail for that particular customer.
You can use following code to extract the information and to save the CSV with Customer name.
Private Sub FindProduct_Click()
Dim DBFullName As String, cnum As Integer
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim col As Long
cnum = InputBox("Enter the Customer Number", FindCustomer)
' Database information
DBFullName = "C:\Users\Mandeep\Desktop\doorstep Organics.mdb"
' Open the connection
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct
' Create RecordSet
Set Recordset = New ADODB.Recordset
' Record locking
With Recordset
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
' Filter
Src = "select customer.customer_no, customer.customer_name, product.product_no,
product.sell_price,orders.order_no,orders.order_status from customer, product,orders
where customer.customer_no=orders.customer_no and orders.product_no = product.product_no
and orders.customer_no = " & cnum
.Open Source:=Src, ActiveConnection:=Connection
' Write the field names
For col = 0 To .Fields.Count - 1
Range("A1").Offset(0, col).Value = .Fields(col).Name
Next col
End With
' Write the recordset
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
Dim fname As String
Range("b2").Select
fname = Range("b2").Value
On Error GoTo check
ChDir "C:\Users\Mandeep\Documents\web info"
ActiveWorkbook.SaveAs Filename:="C:\Users\Mandeep\Documents\web info\" & fname & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
Application.CommandBars("Stop Recording").Visible = False
MsgBox "CSV Successfully saved"
check:
End Sub
