Option Compare Database
Public Function GetFile()
Dim fDialog As Office.FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Do not allow user to make multiple selections
.AllowMultiSelect = False
'Set the title of the dialog box
.Title = "Please select Internet Transaction file to import."
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Excel", "*.xls"
'show the dialog box. If the .show method returns "true", the user picked
'at least one file. If the .show method is "false", the user clicked Cancel.
If .Show = True Then
For Each varFile In .SelectedItems
'This pulls out the file name from the path string
Dim ReversedString As String, FirstFind As Integer
ReversedString = StrReverse(varFile)
FirstFind = InStr(ReversedString, "\") - 1
FileName = StrReverse(Mid(ReversedString, 1, FirstFind))
'Import Cobra Transactions
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Internet Transactions", _
FileName, 1
[red][b] 'Import Eligiblity Information
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Internet Eligibility Information", _
FileName, 1, "[Sheet2]A1:G200"[/b][/red]
'IMport Other Information
Next
Else
MsgBox ("You either hit Cancel or did not select a file. Please try again.")
End If
End With
End Function
Public Function ImportRecords()
'Specify the OLE DB provider and open the connection
Set cnnCobraInternet = CurrentProject.Connection
strSQL = "SELECT DISTINCT SSN FROM [Internet Transactions]"
Set rstDistinctSSN = New ADODB.Recordset
rstDistinctSSN.Open strSQL, cnnCobraInternet, adOpenKeyset, adLockOptimistic
'assign rstDistinctSSN as the recordset for the form
'Me.Recordset = rstDistinctSSN
rstDistinctSSN.MoveFirst
'Loop through all SSN's in in Internet Transaction table
Do While rstDistinctSSN.EOF = False
MsgBox rstDistinctSSN!SSN
'create second recordset for plan information
Set rs = New ADODB.Recordset
strSQL2 = "Select Travis_Code from [qrycontrol3] where SSN = " & "'" & rstDistinctSSN!SSN & "'"
rs.Open strSQL2, cnnCobraInternet, adOpenKeyset, adLockOptimistic
If rs.EOF = True Then
MsgBox "There are not records to import"
Else
rs.MoveFirst
End If
'loop through inner recordset, update the staging table with plan information
Do While rs.EOF = False
Dim intcount As Integer
intcount = rs.RecordCount
MsgBox rs.AbsolutePosition & " of " & intcount
Select Case rs.AbsolutePosition
Case 1 'Plan 1 insert only
ins = "Insert into tblStagingTable(SSN,Control,Rel_Code,Plan_1,[Note Date],Elig_1)values " & _
"(" & rstDistinctSSN!SSN & ", 3 ,'COVERAGE','" & rs!Travis_Code & "'," & _
"" & Format(Date, "yyyy-mm-dd") & ", 'A')"
cnnCobraInternet.Execute ins
'All subsequent plans will be udpate statements
Case 2
ins = "update tblStagingTable set Plan_2 = '" & rs!Travis_Code & "', Travis_Elig_Code = 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
Debug.Print (ins)
cnnCobraInternet.Execute ins
Case 3
ins = "update tblStagingTable set Plan_3 = '" & rs!Travis_Code & "',ELIG_3= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 4
ins = "update tblStagingTable set Plan_4 = '" & rs!Travis_Code & "',ELIG_4= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 5 'Dental?
ins = "update tblStagingTable set Plan_5 = '" & rs!Travis_Code & "',ELIG_5= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 6
ins = "update tblStagingTable set Plan_6 = '" & rs!Travis_Code & "',ELIG_6= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 7
ins = "update tblStagingTable set Plan_7 = '" & rs!Travis_Code & "',ELIG_7= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 8
ins = "update tblStagingTable set Plan_8 = '" & rs!Travis_Code & "',ELIG_8= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
Case 9
ins = "update tblStagingTable set Plan_9 = '" & rs!Travis_Code & "',ELIG_9= 'A' where SSN = '" & rstDistinctSSN!SSN & "'"
cnnCobraInternet.Execute ins
'If there is over 9 plans, reject this record
Case Else
MsgBox "There are to many plans listed for SSN " & "rstDistinctSSN!SSN" & _
"This record will not be imported"
End Select
rs.MoveNext
Loop
'Clear recordset
Set rs = Nothing
rstDistinctSSN.MoveNext
Loop
'Insert Employee information
DoCmd.OpenQuery "qryControl1"
End Function
