mpearce
04-29-2009, 01:58 PM
Sorry for the length of this code, but when the below code runs everything up to the export routine is run. when the export routine is run i get:
run-time error '2001'
you canceled the previous operation.
I am not sure why i am getting that error. Here is my code:
Option Compare Database
Option Explicit
Private Sub btnImport_Click()
Dim objdialog As Variant
Dim objdialog2 As Variant
Dim intresult As Integer
Dim yestreferral As String
Dim todayreferral As String
Dim intresult2 As Integer
Dim refdate As String
Dim ech_records As Integer
Dim ermc_records As Integer
Dim mmc_records As Integer
Dim mhh_records As Integer
Dim stbhc_records As Integer
Set objdialog = CreateObject("UserAccounts.CommonDialog")
Set objdialog2 = CreateObject("UserAccounts.CommonDialog")
Call open_(objdialog, objdialog2, intresult, yestreferral, todayreferral, intresult2)
Call deleteReferrals
Call import(yestreferral, todayreferral)
Call export(refdate, ech_records, ermc_records, mmc_records, mhh_records, stbhc_records)
End Sub
Sub open_(objdialog As Variant, objdialog2 As Variant, intresult As Integer, ByRef yestreferral As String, ByRef todayreferral As String, intresult2 As Integer)
objdialog.Filter = "Text Files|*.txt|All Files|*.*"
objdialog.InitialDir = "x:\uhs south tx\referrals"
objdialog2.Filter = "Text Files|*.txt|All Files|*.*"
objdialog2.InitialDir = "x:\uhs south tx\referrals"
Do While intresult = 0
intresult = objdialog.ShowOpen
MsgBox "Select a file to continue", vbCritical, "!!ERROR!!"
Loop
yestreferral = objdialog.FileName
MsgBox yestreferral
Do While intresult2 = 0
intresult2 = objdialog2.ShowOpen
MsgBox "Select a file to continue", vbCritical, "!!ERROR!!"
Loop
todayreferral = objdialog2.FileName
MsgBox todayreferral
End Sub
Sub deleteReferrals()
DoCmd.RunSQL "DELETE UHS Referrals Yesterday.* FROM [UHS Referrals Yesterday];"
DoCmd.RunSQL "DELETE UHS Referrals Today.* FROM [UHS Referrals Today];"
End Sub
Sub import(yestreferral As String, todayreferral As String)
DoCmd.TransferText acImportDelim, "UHS import specification", "UHS Referrals Yesterday", yestreferral, -1
DoCmd.TransferText acImportDelim, "UHS import specification", "UHS Referrals Today", todayreferral, -1
End Sub
Sub export(ByVal refdate As String, ByVal ech_records As Integer, ByVal ermc_records As Integer, ByVal mmc_records As Integer, ByVal mhh_records As Integer, ByVal stbhc_records As Integer)
refdate = InputBox("Enter the date that these referrals were received in the format MM-DD-YYYY", "Referral Date", "MMDDYYYY")
'here is where the problem starts
ech_records = DCount("*", "ECH")
Select Case ech_records
Case Is > 0
MsgBox refdate
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ECH", "X:\UHS South TX\Referrals\ready for import\ECH " & refdate & ".txt", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ECH", "X:\UHS South TX\Referrals\Files with no referrals\ECH no referral " & refdate & ".txt"
End Select
ermc_records = DCount("*", "ERMC")
Select Case ermc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ERMC", "X:\UHS South TX\Referrals\ready for import\ERMC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ERMC", "X:\UHS South TX\Referrals\ready for import\ERMC no referral " & refdate & ".txt"
End Select
mhh_records = DCount("*", "MHH")
Select Case mhh_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MHH", "X:\UHS South TX\Referrals\ready for import\MHH " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MHH", "X:\UHS South TX\Referrals\ready for import\MHH no referral " & refdate & ".txt"
End Select
mmc_records = DCount("*", "MMC")
Select Case mmc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MMC", "X:\UHS South TX\Referrals\ready for import\MMC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MMC", "X:\UHS South TX\Referrals\ready for import\MMC no referral " & refdate & ".txt"
End Select
stbhc_records = DCount("*", "STBHC")
Select Case stbhc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "STBHC", "X:\UHS South TX\Referrals\ready for import\STBHC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "STBHC", "X:\UHS South TX\Referrals\ready for import\STBHC no referral " & refdate & ".txt"
End Select
MsgBox "Export Complete. Summary:" & vbCrLf & "There were " & ech_records & " new referrals for ECH" & vbCrLf & _
"There were " & ermc_records & " new referrals for ERMC" & vbCrLf & "There were " & mhh_records & " new referrals for MHH" & _
vbCrLf & "There were " & mmc_records & " new referrals for MMC" & vbCrLf & "There were " & stbhc_records _
& " new referrals for STBHC", vbInformation, "Results"
End Sub
Thanks in advance for any help!
run-time error '2001'
you canceled the previous operation.
I am not sure why i am getting that error. Here is my code:
Option Compare Database
Option Explicit
Private Sub btnImport_Click()
Dim objdialog As Variant
Dim objdialog2 As Variant
Dim intresult As Integer
Dim yestreferral As String
Dim todayreferral As String
Dim intresult2 As Integer
Dim refdate As String
Dim ech_records As Integer
Dim ermc_records As Integer
Dim mmc_records As Integer
Dim mhh_records As Integer
Dim stbhc_records As Integer
Set objdialog = CreateObject("UserAccounts.CommonDialog")
Set objdialog2 = CreateObject("UserAccounts.CommonDialog")
Call open_(objdialog, objdialog2, intresult, yestreferral, todayreferral, intresult2)
Call deleteReferrals
Call import(yestreferral, todayreferral)
Call export(refdate, ech_records, ermc_records, mmc_records, mhh_records, stbhc_records)
End Sub
Sub open_(objdialog As Variant, objdialog2 As Variant, intresult As Integer, ByRef yestreferral As String, ByRef todayreferral As String, intresult2 As Integer)
objdialog.Filter = "Text Files|*.txt|All Files|*.*"
objdialog.InitialDir = "x:\uhs south tx\referrals"
objdialog2.Filter = "Text Files|*.txt|All Files|*.*"
objdialog2.InitialDir = "x:\uhs south tx\referrals"
Do While intresult = 0
intresult = objdialog.ShowOpen
MsgBox "Select a file to continue", vbCritical, "!!ERROR!!"
Loop
yestreferral = objdialog.FileName
MsgBox yestreferral
Do While intresult2 = 0
intresult2 = objdialog2.ShowOpen
MsgBox "Select a file to continue", vbCritical, "!!ERROR!!"
Loop
todayreferral = objdialog2.FileName
MsgBox todayreferral
End Sub
Sub deleteReferrals()
DoCmd.RunSQL "DELETE UHS Referrals Yesterday.* FROM [UHS Referrals Yesterday];"
DoCmd.RunSQL "DELETE UHS Referrals Today.* FROM [UHS Referrals Today];"
End Sub
Sub import(yestreferral As String, todayreferral As String)
DoCmd.TransferText acImportDelim, "UHS import specification", "UHS Referrals Yesterday", yestreferral, -1
DoCmd.TransferText acImportDelim, "UHS import specification", "UHS Referrals Today", todayreferral, -1
End Sub
Sub export(ByVal refdate As String, ByVal ech_records As Integer, ByVal ermc_records As Integer, ByVal mmc_records As Integer, ByVal mhh_records As Integer, ByVal stbhc_records As Integer)
refdate = InputBox("Enter the date that these referrals were received in the format MM-DD-YYYY", "Referral Date", "MMDDYYYY")
'here is where the problem starts
ech_records = DCount("*", "ECH")
Select Case ech_records
Case Is > 0
MsgBox refdate
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ECH", "X:\UHS South TX\Referrals\ready for import\ECH " & refdate & ".txt", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ECH", "X:\UHS South TX\Referrals\Files with no referrals\ECH no referral " & refdate & ".txt"
End Select
ermc_records = DCount("*", "ERMC")
Select Case ermc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ERMC", "X:\UHS South TX\Referrals\ready for import\ERMC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "ERMC", "X:\UHS South TX\Referrals\ready for import\ERMC no referral " & refdate & ".txt"
End Select
mhh_records = DCount("*", "MHH")
Select Case mhh_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MHH", "X:\UHS South TX\Referrals\ready for import\MHH " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MHH", "X:\UHS South TX\Referrals\ready for import\MHH no referral " & refdate & ".txt"
End Select
mmc_records = DCount("*", "MMC")
Select Case mmc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MMC", "X:\UHS South TX\Referrals\ready for import\MMC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "MMC", "X:\UHS South TX\Referrals\ready for import\MMC no referral " & refdate & ".txt"
End Select
stbhc_records = DCount("*", "STBHC")
Select Case stbhc_records
Case Is > 0
DoCmd.TransferText acExportDelim, "UHS Export Specification", "STBHC", "X:\UHS South TX\Referrals\ready for import\STBHC " & refdate & ".TXT", False
Case Is < 1
DoCmd.TransferText acExportDelim, "UHS Export Specification", "STBHC", "X:\UHS South TX\Referrals\ready for import\STBHC no referral " & refdate & ".txt"
End Select
MsgBox "Export Complete. Summary:" & vbCrLf & "There were " & ech_records & " new referrals for ECH" & vbCrLf & _
"There were " & ermc_records & " new referrals for ERMC" & vbCrLf & "There were " & mhh_records & " new referrals for MHH" & _
vbCrLf & "There were " & mmc_records & " new referrals for MMC" & vbCrLf & "There were " & stbhc_records _
& " new referrals for STBHC", vbInformation, "Results"
End Sub
Thanks in advance for any help!