Embedded Files
Function API()
'Reading from Database cell
Dim db As Database
Dim TicketNumb As DAO.Recordset
Dim ticketvar As String
Dim TicketNum As String
'Open connection to current Access database
Set db = CurrentDb()
'Create SQL statement to retrieve value from GST table
ticketvar = "select Ticket from qry_tblMAIN"
Set TicketNumb = db.OpenRecordset(ticketvar)
'Retrieve value if data is found
If TicketNumb.EOF = False Then
TicketNum = TicketNumb("Ticket")
Else
TicketNum = "Not found"
End If
TicketNumb.Close
Set TicketNumb = Nothing
GetTicket = TicketNum
'Export Payables csv file
Dim trz As Integer
Dim strCSV As String
For trz = 1 To 511
Close #trz
Next trz
trz = FreeFile
Open "C:\Users\NAME\Documents\" & (TicketNum) & "_API.csv" For Output Access Write As #trz
With CurrentDb.OpenRecordset("qryRESUME ")
Dim x As Integer
For x = 0 To .Fields.Count - 1
strCSV = strCSV & strColumnDelimiter & .Fields(x).Name & ", "
Next x
Print #trz, Mid(strCSV, Len(strColumnDelimiter) + 1)
Do Until .EOF
strCSV = ""
For x = 0 To .Fields.Count - 1
strCSV = strCSV & strColumnDelimiter & Nz(.Fields(x), "") & ", "
Next x
Print #trz, Mid(strCSV, Len(strColumnDelimiter) + 1)
.MoveNext
Loop
End With
Close #trz
'Check file exist
Dim FilePath As String
Dim TestStr As String
FilePath = "C:\Users\NAME\Documents\" & (TicketNum) & "_API.csv"
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
If TestStr = "" Then
MsgBox "File doesn't exist. Submit your request again"
Else
'Delete first line on csv file
Dim iFile As Integer
Dim sData As String
iFile = FreeFile
Open "C:\Users\NAME\Documents\" & (TicketNum) & "_API.csv" For Binary Access Read As iFile
sData = Space(LOF(iFile))
Get #iFile, , sData
Close iFile
sData = Mid(sData, InStr(sData, vbCrLf) + 2)
Kill "C:\Users\Michelle\Documents\" & (TicketNum) & "_API.csv"
iFile = FreeFile
Open "C:\Users\NAME\Documents\" & (TicketNum) & "_API.csv" For Binary Access Write As iFile
Put #iFile, , sData
Close iFile
End If
Page updated
Google Sites
Report abuse