Results 1 to 3 of 3

Access - Run Time Error 3049

  1. #1
    pfarley1212 is offline Novice
    Windows 7 32bit Access 2010 32bit
    Join Date
    Jun 2013
    Posts
    1

    Exclamation Access - Run Time Error 3049

    Hi,

    I have a macro that I am running in Microsoft Access and I am receiving an error "Run Time Error 3049. Cannot Open Database. It may not be a database that your application recognizes, or the file may be corrupt". I'm positive that the file isn't corrupt and not sure why it's saying it can't recognize the database. Can you please help? The code of my query is below and I have highlighted where it errors out and where I have to debug. THANKS!!

    Function EAPGIn()

    Open Application.CurrentProject.Path & "\" & "EAPGFromGrouperData.csv" For Input As #1
    Open Application.CurrentProject.Path & "\" & "EAPGGrouperJobLog.txt" For Append As #2
    Print #2, Date & " " & Time & " >------- Start EAPGIn"
    '
    Dim SQLQuery As String
    Dim IREC As Double
    Dim StrLine As String
    Dim SplitLine() As String
    Dim SplitHeaders() As String
    Dim ItemCounter As Double
    Dim I As Integer
    Dim Z As Integer
    Dim EpisodeNo As String
    Dim HCPCSString() As String
    Dim RevString() As String
    Dim DOSString() As String
    Dim ItemChargesString() As String
    Dim EAPGString() As String
    Dim EAPGTypeString() As String
    Dim EAPGCategoryString() As String
    Dim GrouperVersion As String
    Dim MultiProcString() As String
    Dim RepeatAncString() As String
    Dim BilateralString() As String
    Dim UnassignedFlagString() As String
    Dim ActionFlagString() As String
    Dim PackageFlagString() As String
    Dim SameProcString() As String
    Dim ClinicalProcString() As String
    Dim ProcEditString() As String
    Dim ClaimProcessFlag As String
    Dim ClaimProcessWarning As String
    Dim ItemVisitTypeString() As String
    Dim ItemVisitWarningString() As String
    Dim ClaimEdits As String
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim NumStatus As Integer
    Dim DteEffective As Double
    Dim DteEnd As Double
    Dim StdConv As Double
    Dim DiscPercent As Double
    Dim AmtThreshold As Double
    Dim NumWeight As Double
    Dim WorkingDate As Double
    Dim EAPGCalcPrice As Double
    Dim EAPGSumCalcPrice As Double
    Dim EAPGSumAmtBilled As Double
    Dim ProvCCR As Double
    Dim EpisodeAmtOutlier As Double
    Dim WeightRecords() As String
    Dim WeightRecord() As String
    '
    '
    ' First, get the Num Stats values from the database where the CUR_RUN flag = "*"
    ' If we can't find that, abort.
    Print #2, Date & " " & Time & " Get Stats"
    NumStatus = 0
    StdConv = 0
    DiscPercent = 0
    AmtThreshold = 0
    NumWeight = 0
    SQLQuery = "SELECT * FROM T_CLM_EAPG_NUM_STATS WHERE T_CLM_EAPG_NUM_STATS.CUR_RUN = ""*"";"
    Set rs3 = CurrentDb.OpenRecordset(SQLQuery)
    If rs3.RecordCount = 0 Then
    Print #2, Date & " " & Time & " Cannot find NUM STATS row, aborting"
    rs3.Close
    GoTo End_Abort
    Else
    NumStatus = rs3.Fields("NUM_STATUS")
    DteEffective = rs3.Fields("DTE_EFFECTIVE")
    DteEnd = rs3.Fields("DTE_END")
    AmtThreshold = rs3.Fields("AMT_THRESHOLD")
    StdConv = rs3.Fields("STD_CONV")
    DiscPercent = rs3.Fields("DISC_PERCENT")
    Print #2, Date & " " & Time & " Num Status " & NumStatus & " Date Eff " & _
    DteEffective & " Date End " & DteEnd & " Threshold " & AmtThreshold & _
    " Std Conv " & StdConv & " Disc Percent " & DiscPercent
    rs3.Close
    End If
    '
    ' Using the NumStatus value, get the relative weights and build an internal table
    ' that will be used for weight lookup during pricing. This speeds things up instead
    ' of queries to the database on each service.
    Print #2, Date & " " & Time & " Build Relative Weights array"
    SQLQuery = "SELECT CDE_EAPG, NUM_WEIGHT from T_CLM_EAPG_REL_WGHT WHERE " & _
    "NUM_STATUS = " & NumStatus & ";"
    Set rs3 = CurrentDb.OpenRecordset(SQLQuery)
    If rs3.RecordCount = 0 Then
    Print #2, Date & " " & Time & " No relative weights selected, aborting"
    rs3.Close
    GoTo End_Abort
    End If
    ' There are usually at least 400 weights
    ReDim Preserve WeightRecords(400)
    I = -1
    Do Until rs3.EOF
    I = I + 1
    If UBound(WeightRecords) < I Then
    ReDim Preserve WeightRecords(I)
    End If
    WeightRecords(I) = rs3.Fields("CDE_EAPG") & "," & rs3.Fields("NUM_WEIGHT")
    rs3.MoveNext
    Loop
    rs3.Close
    '
    ' Drop Grouper Header Table
    Print #2, Date & " " & Time & " Drop T_CLM_EAPG_GROUPER_HDR"
    On Error Resume Next
    SQLQuery = "DROP TABLE T_CLM_EAPG_GROUPER_HDR;"
    CurrentDb.Execute SQLQuery
    On Error GoTo 0
    '
    ' Build Grouper Header Table
    Print #2, Date & " " & Time & " Create T_CLM_EAPG_GROUPER_HDR"
    SQLQuery = "CREATE TABLE T_CLM_EAPG_GROUPER_HDR (EPISODE NUMERIC PRIMARY KEY, " & _
    "GROUPER_VERSION_USED VARCHAR, CLAIM_PROCESSED_FLAG VARCHAR, " & _
    "EAPG_SUM_CALC_PRICE NUMERIC, EPISODE_BILLED NUMERIC, AMT_COST_CHRG NUMERIC, " & _
    "AMT_OUTLIER NUMERIC, EPISODE_PRICE NUMERIC, CLAIM_PROCESSED_WARNING VARCHAR, " & _
    "CLAIM_EDITS VARCHAR);"
    CurrentDb.Execute SQLQuery
    '
    ' Drop Grouper Detail Table
    Print #2, Date & " " & Time & " Drop T_CLM_EAPG_GROUPER_DTL"
    On Error Resume Next
    SQLQuery = "DROP TABLE T_CLM_EAPG_GROUPER_DTL;"
    CurrentDb.Execute SQLQuery
    On Error GoTo 0
    '
    ' Build Grouper Detail Table
    Print #2, Date & " " & Time & " Create T_CLM_EAPG_GROUPER_DTL"
    '
    SQLQuery = "CREATE TABLE T_CLM_EAPG_GROUPER_DTL (EPISODE NUMERIC, EPISODE_SEQ NUMERIC, " & _
    "CDE_PROCEDURE VARCHAR, CDE_REVENUE VARCHAR, ITEM_FINAL_EAPG NUMERIC, EAPG_NUM_WEIGHT NUMERIC, " & _
    "EAPG_CALC_PRICE NUMERIC, ITEM_FINAL_EAPG_TYPE VARCHAR, ITEM_FINAL_EAPG_CATEGORY VARCHAR, " & _
    "ITEM_MULTI_PROC_DISC_FLAG VARCHAR, ITEM_REPEAT_ANC_DISC_FLAG VARCHAR, " & _
    "ITEM_BILAT_DISC_FLAG VARCHAR, ITEM_UNASSIGNED_FLAG VARCHAR, ITEM_ACTION_FLAG VARCHAR, " & _
    "ITEM_PACKAGING_FLAG VARCHAR, ITEM_SAME_PROC_CONS_FLAG VARCHAR, ITEM_CLINICALPROC_CONS_FLAG VARCHAR, " & _
    "ITEM_PROCEDURE_EDITS VARCHAR, ITEM_OVERALL_VISIT_TYPE VARCHAR, ITEM_VISIT_PROCESSED_WARNING VARCHAR, " & _
    "CONSTRAINT PrimaryKey PRIMARY KEY (EPISODE, EPISODE_SEQ));"
    CurrentDb.Execute SQLQuery
    '
    Set rs1 = CurrentDb.OpenRecordset("T_CLM_EAPG_GROUPER_HDR")
    Set rs2 = CurrentDb.OpenRecordset("T_CLM_EAPG_GROUPER_DTL")
    '
    Print #2, Date & " " & Time & " Read input file and build output tables"
    IREC = 0
    Do Until EOF(1)
    Line Input #1, StrLine
    If Left(StrLine, 1) = "A" Then '<-- first record is headers
    SplitHeaders = Split(StrLine, ",")
    ' Print #2, Date & " " & Time & " File Headers " & StrLine
    GoTo Skip_Loop
    End If
    IREC = IREC + 1
    ' Split the input record to individual fields and arrays for those fields with multiple values
    SplitLine = Split(StrLine, ",")
    EpisodeNo = SplitLine(0)
    HCPCSString = Split(SplitLine(1), ";")
    RevString = Split(SplitLine(2), ";")
    DOSString = Split(SplitLine(3), ";")
    ItemChargesString = Split(SplitLine(4), ";")
    EAPGString = Split(SplitLine(5), ";")
    EAPGTypeString = Split(SplitLine(6), ";")
    EAPGCategoryString = Split(SplitLine(7), ";")
    GrouperVersion = SplitLine(8)
    MultiProcString = Split(SplitLine(9), ";")
    RepeatAncString = Split(SplitLine(10), ";")
    BilateralString = Split(SplitLine(11), ";")
    UnassignedFlagString = Split(SplitLine(12), ";")
    ActionFlagString = Split(SplitLine(13), ";")
    PackageFlagString = Split(SplitLine(14), ";")
    SameProcString = Split(SplitLine(15), ";")
    ClinicalProcString = Split(SplitLine(16), ";")
    ProcEditString = Split(SplitLine(17), ";")
    ClaimProcessFlag = SplitLine(18)
    ClaimProcessWarning = SplitLine(19)
    ItemVisitTypeString = Split(SplitLine(20), ";")
    ItemVisitWarningString = Split(SplitLine(21), ";")
    ClaimEdits = SplitLine(22)
    '
    ' Item level fields
    '
    ' The number of occurances in the revenue code string dicates looping.
    ' Note it starts at zero.
    EAPGSumAmtBilled = 0
    EAPGSumCalcPrice = 0
    For I = 0 To UBound(RevString)
    With rs2
    .AddNew
    .Fields("EPISODE") = EpisodeNo
    .Fields("EPISODE_SEQ") = (I + 1)
    .Fields("CDE_REVENUE") = RevString(I)
    If I <= UBound(HCPCSString) Then
    .Fields("CDE_PROCEDURE") = HCPCSString(I)
    End If
    ' WorkingDate = CDbl(Right(DOSString(I), 4) & Left(DOSString(I), 4))
    EAPGSumAmtBilled = EAPGSumAmtBilled + CDbl(ItemChargesString(I))
    '
    ' 04/23/12
    '
    If UnassignedFlagString(I) = "11" Or UnassignedFlagString(I) = "12" Then
    EAPGString(I) = "501"
    ' MsgBox "unassignedflag" & UnassignedFlagString(I) & " eapgstring(i)" & EAPGString(I)
    End If
    '
    .Fields("ITEM_FINAL_EAPG") = CDbl(EAPGString(I))
    .Fields("ITEM_FINAL_EAPG_TYPE") = EAPGTypeString(I)
    .Fields("ITEM_FINAL_EAPG_CATEGORY") = EAPGCategoryString(I)
    .Fields("ITEM_MULTI_PROC_DISC_FLAG") = MultiProcString(I)
    .Fields("ITEM_REPEAT_ANC_DISC_FLAG") = RepeatAncString(I)
    .Fields("ITEM_BILAT_DISC_FLAG") = BilateralString(I)
    .Fields("ITEM_UNASSIGNED_FLAG") = UnassignedFlagString(I)
    If I <= UBound(ActionFlagString) Then
    If ActionFlagString(I) > "" Then
    .Fields("ITEM_ACTION_FLAG") = ActionFlagString(I)
    Else
    .Fields("ITEM_ACTION_FLAG") = " "
    End If
    End If
    .Fields("ITEM_PACKAGING_FLAG") = PackageFlagString(I)
    .Fields("ITEM_SAME_PROC_CONS_FLAG") = SameProcString(I)
    .Fields("ITEM_CLINICALPROC_CONS_FLAG") = ClinicalProcString(I)
    If I <= UBound(ProcEditString) Then
    If ProcEditString(I) > "" Then
    .Fields("ITEM_PROCEDURE_EDITS") = ProcEditString(I)
    Else
    .Fields("ITEM_PROCEDURE_EDITS") = " "
    End If
    End If
    If I <= UBound(ItemVisitTypeString) Then
    If ItemVisitTypeString(I) > "" Then
    .Fields("ITEM_OVERALL_VISIT_TYPE") = ItemVisitTypeString(I)
    Else
    .Fields("ITEM_OVERALL_VISIT_TYPE") = " "
    End If
    End If
    If I <= UBound(ItemVisitWarningString) Then
    If ItemVisitWarningString(I) > "" Then
    .Fields("ITEM_VISIT_PROCESSED_WARNING") = ItemVisitWarningString(I)
    Else
    .Fields("ITEM_VISIT_PROCESSED_WARNING") = " "
    End If
    End If
    '
    ' Price the service
    '
    NumWeight = 0
    If CDbl(EAPGString(I)) = 0 Or CDbl(EAPGString(I)) = 999 Then
    EAPGCalcPrice = 0
    GoTo Skip_Dtl_Pricing
    End If
    For Z = 0 To UBound(WeightRecords)
    WeightRecord = Split(WeightRecords(Z), ",")
    If EAPGString(I) = WeightRecord(0) Then
    NumWeight = CDbl(WeightRecord(1))
    GoTo Skip_Weight_Array
    End If
    Next Z
    Skip_Weight_Array:
    'MsgBox (Z & " " & NumWeight & " " & EAPGString(I))
    If NumWeight = 0 Then
    Print #2, Date & " " & Time & " Cannot price Episode/Seq/EAPG " & EpisodeNo & _
    "/" & (I + 1) & "/" & EAPGString(I)
    GoTo Skip_Dtl_Pricing
    ' Else
    ' .Fields("WEIGHT_ERROR_FLAG") = " "
    End If
    EAPGCalcPrice = NumWeight * StdConv
    If MultiProcString(I) = "1" Then
    EAPGCalcPrice = EAPGCalcPrice * DiscPercent
    ElseIf RepeatAncString(I) = "1" Then
    EAPGCalcPrice = EAPGCalcPrice * DiscPercent
    ElseIf BilateralString(I) = "1" Then
    EAPGCalcPrice = EAPGCalcPrice * DiscPercent
    ElseIf PackageFlagString(I) = "1" Then
    EAPGCalcPrice = 0
    ElseIf SameProcString(I) = "1" Then
    EAPGCalcPrice = 0
    ElseIf ClinicalProcString(I) = "1" Then
    EAPGCalcPrice = 0
    End If
    Skip_Dtl_Pricing:
    .Fields("EAPG_NUM_WEIGHT") = NumWeight
    .Fields("EAPG_CALC_PRICE") = EAPGCalcPrice
    EAPGSumCalcPrice = EAPGSumCalcPrice + EAPGCalcPrice
    .Update
    End With
    Next I
    '
    ' Write the header
    With rs1
    .AddNew
    .Fields("EPISODE") = EpisodeNo
    If GrouperVersion > "" Then
    .Fields("GROUPER_VERSION_USED") = GrouperVersion
    Else
    .Fields("GROUPER_VERSION_USED") = " "
    End If
    .Fields("CLAIM_PROCESSED_FLAG") = ClaimProcessFlag
    .Fields("EAPG_SUM_CALC_PRICE") = EAPGSumCalcPrice
    .Fields("EPISODE_BILLED") = EAPGSumAmtBilled
    .Fields("CLAIM_PROCESSED_WARNING") = ClaimProcessWarning
    If ClaimEdits > "" Then
    .Fields("CLAIM_EDITS") = ClaimEdits
    Else
    .Fields("CLAIM_EDITS") = " "
    End If
    '
    ' Episode pricing
    SQLQuery = "SELECT DISTINCT T_CLM_EAPG_PRV_CCR.AMT_COST_CHRG " & _
    "FROM (T_CLM_EAPG_EPISODE_XRF INNER JOIN T_CLM_EAPG_HDR_EXTRACT ON " & _
    "T_CLM_EAPG_EPISODE_XRF.SAK_CLAIM = T_CLM_EAPG_HDR_EXTRACT.SAK_CLAIM) " & _
    "INNER JOIN T_CLM_EAPG_PRV_CCR ON T_CLM_EAPG_HDR_EXTRACT.NUM_TAX_ID " & _
    "= T_CLM_EAPG_PRV_CCR.NUM_TAX_ID " & _
    "WHERE (((T_CLM_EAPG_EPISODE_XRF.EPISODE)= " & EpisodeNo & _
    ") AND ((T_CLM_EAPG_PRV_CCR.NUM_STATUS)= " & NumStatus & _
    "));"
    Set rs3 = CurrentDb.OpenRecordset(SQLQuery)
    If rs3.RecordCount = 0 Or rs3.RecordCount > 1 Then
    Print #2, Date & " " & Time & " Cannot retrieve Provider CCR for Episode " & _
    NumStatus & " / " & EpisodeNo
    MsgBox "Cannot retrieve Provider CCR for Episode " & NumStatus & " / " & EpisodeNo
    GoTo End_Abort
    End If
    ProvCCR = rs3.Fields(0)
    .Fields("AMT_COST_CHRG") = rs3.Fields(0)
    rs3.Close
    ' calculate outlier and final episode price
    If ((EAPGSumAmtBilled * ProvCCR) - EAPGSumCalcPrice) > AmtThreshold Then
    EpisodeAmtOutlier = ((EAPGSumAmtBilled * ProvCCR) - EAPGSumCalcPrice)
    Else
    EpisodeAmtOutlier = 0
    End If
    .Fields("AMT_OUTLIER") = EpisodeAmtOutlier
    .Fields("EPISODE_PRICE") = EAPGSumCalcPrice + EpisodeAmtOutlier
    .Update
    End With
    '
    Skip_Loop:
    Loop
    '
    End_Abort:
    Close #1
    Print #2, Date & " " & Time & " Episodes input - " & IREC
    Print #2, Date & " " & Time & " >------- End EAPGIn"
    Close #2
    rs1.Close
    rs2.Close
    '
    End Function

  2. #2
    June7's Avatar
    June7 is online now Moderator
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    29,536
    The hightlighted line is .Update toward end of the procedure. This is the line causing error?

    You are trying to add records to rs1 and the Update is failing?

    I can't see anything wrong with the code.

    If you want to provide files for analysis, follow instructions at bottom of my post.
    To provide db: Make copy, remove confidential data, run compact & repair, zip if large - 2mb allowed, attach to post. Attachment Manager is below the Advanced post editor window.
    If suggestion in this post resolves your issue, please use the Thread Tools and mark the thread as Solved!

    Debug!Debug!Debug! http://www.cpearson.com/excel/debug.htm

  3. #3
    tanvi is offline Advanced Beginner
    Windows XP Access 2010 32bit
    Join Date
    Mar 2012
    Posts
    96
    Have you run Compact & Repair?
    If not, first run it..

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 15
    Last Post: 12-04-2012, 11:39 AM
  2. Run Time Error 3021 - Access 2002 SP3
    By alpinegroove in forum Programming
    Replies: 9
    Last Post: 01-24-2012, 02:38 PM
  3. Fixing run-time error 3049
    By kthakk4 in forum Programming
    Replies: 1
    Last Post: 09-30-2011, 06:37 AM
  4. Run Time Error 3075 in Access 2007
    By jblank65 in forum Programming
    Replies: 6
    Last Post: 01-25-2011, 02:47 PM
  5. Replies: 2
    Last Post: 12-23-2010, 07:11 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Tech Forums: Microsoft Office Forums