Call

SQL Server Integration: Import and Export with Excel


Excel is an amazing utility that allows you to not only perform common functions and equations, 

but it also allows users to “hook-up” up with outside databases and files. 

Here is a wonderful set of code that will hopefully give you an idea about record sets, tables,

importing an exporting to Excel as well as Access/SQL server.


 Private Sub btnPopulate_Click()
	
    Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset, rs3 As ADODB.Recordset
Dim rs4 As ADODB.Recordset, rs5 As ADODB.Recordset
	
    Set cn = Application.CurrentProject.Connection
    Set rs = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    Set rs3 = New ADODB.Recordset
    Set rs4 = New ADODB.Recordset
    Set rs5 = New ADODB.Recordset
    Dim intCountmiss As Integer
    Dim intFundUp As Integer
    Dim intMaster As Integer
    intFundUp = lblFundUp.Caption
    intMaster = lblMaster.Caption
    intCountmiss = 0
    txtAsOfDate.SetFocus
    DoCmd.Hourglass (1)
   
    strSql = "DELETE FROM tblNotUploaded"
    CurrentProject.Connection.Execute strSql
   
    rs.Open "tblFunds", CurrentProject.Connection, adOpenStatic, adLockOptimistic
    Do While Not rs.EOF
	
        strFundName = rs.Fields("FundName")
        strSql = "SELECT * FROM tblRecent WHERE FundName='" & strFundName & "'"
        rs2.Open strSql, cn, adOpenStatic, adLockOptimistic
       
        If rs2.EOF Then
            rs3.Open "tblNotUploaded", CurrentProject.Connection, adOpenStatic,_
adLockOptimistic
	
                If (rs3.Supports(adAddNew)) Then
                    rs3.AddNew
                    rs3.Fields("FundName") = strFundName
                    rs3.Update
                End If
                rs3.Close
                intCountmiss = intCountmiss + 1
        End If
        CountMissing.Caption = intCountmiss
        rs2.Close
        rs.MoveNext
    Loop
    rs.Close
    DeleteList.Requery
 
       
'Find if fund uploaded is not on Master List
        rs4.Open "tblRecent", CurrentProject.Connection, adOpenStatic,_
adLockOptimistic
	
        Do While Not rs4.EOF
            strFundName2 = rs4.Fields("FundName")
            strSql = "SELECT * FROM tblFunds WHERE FundName='" & strFundName2 & "'"
            rs5.Open strSql, cn, adOpenStatic, adLockOptimistic
                If rs5.EOF Then
                    MsgBox "The Fund " & strFundName2 & " is missing from the master list!", vbExclamation
                End If
            rs4.MoveNext
            rs5.Close
           
        Loop
            rs4.Close
           
    'rs = Nothing
    'rs2 = Nothing
    'rs3 = Nothing
    'rs4 = Nothing
    'rs5 = Nothing
   
    DoCmd.Hourglass (0)
   
End Sub
'***************************************
	
'**** 1. UPLOAD Rates and Breaks *******
'***************************************
Sub btnUpload_Click()
txtAsOfDate.SetFocus
On Error GoTo Err_Handler
	
    If IsDate(txtAsOfDate) = False Then
        MsgBox ("Please enter a valid 'As Of Date'")
        GoTo Err_Exit
    End If
   
    DoCmd.SetWarnings (0)
    DoCmd.Hourglass (1)
   
    Set cn = Application.CurrentProject.Connection
    Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset, rs3 As ADODB.Recordset,
Dim rs4 As ADODB.Recordset, rs5 As ADODB.Recordset, rs6 As ADODB.Recordset
	
    Dim fso As New FileSystemObject
   
   
    Dim nores As Integer
	
   
    Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
    Dim intFundUp As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rs = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    Set rs3 = New ADODB.Recordset
    Set rs4 = New ADODB.Recordset
    Set rs5 = New ADODB.Recordset
    Set rs6 = New ADODB.Recordset
    intFundUp = 0
    CountMissing.Caption = 0
    strSql = "DELETE FROM tblRecent"
    CurrentProject.Connection.Execute strSql
    strSql = "DELETE FROM Breaks2"
    CurrentProject.Connection.Execute strSql
    strSql = "DELETE FROM tblNotUploaded"
    CurrentProject.Connection.Execute strSql
    DeleteList.Requery
   
    strMonth = Month(txtAsOfDate)
    strYear = Year(txtAsOfDate)
    If Len(strMonth) = 1 Then strMonth = "0" & strMonth
    strPeriod = strYear & "." & strMonth
    strPath = "P:DepartmentCTS-AccountantsPAU GroupMISPosition Breaks" & strYear &_
"" & strMonth
	
   
    '** ITERATE THROUGH XL FILES **
    For Each File In fso.getfolder(strPath).Files
        Set xlApp = New Excel.Application
        With xlApp
            xlApp.Visible = True
            Set xlBook = .Workbooks.Open(FileName:=File)
           
               
	
            '** UPLOAD BREAKS **
            If SheetExists("Items", xlBook) Then
                Set xlSheet = xlBook.Worksheets("Items")
                With xlSheet
                   rmax = .UsedRange.Rows.Count
                   For r = 1 To rmax
                
                    
                       '**New Position mapping**
                      
                       strFundName = .Cells(r, 1): c = "A"
                       strPfID = .Cells(r, 2): c = "B"
                       strTXdate = CDate(.Cells(r, 3)): c = "C"
                       strRecDate = .Cells(r, 4): c = "D"
                       strPreparedBy = .Cells(r, 5): c = "E"
                       strAccountant = .Cells(r, 6): c = "F"
                       strInvestment = .Cells(r, 7): c = "G"
                       strSecID = .Cells(r, 8): c = "H"
                       intGVAquant = .Cells(r, 9): c = "I"
                       intBKRquant = .Cells(r, 10): c = "J"
                       intdiff = .Cells(r, 11): c = "K"
                       intGVAprice = .Cells(r, 12): c = "L"
                       intBKRprice = .Cells(r, 13): c = "M"
                       intPriceDiff = .Cells(r, 14): c = "N"
                       intGVAmktVal = .Cells(r, 15): c = "O"
                       intBKRmktVal = .Cells(r, 16): c = "P"
                       intMKTvalDIF = .Cells(r, 17): c = "Q"
                       intGVAbkMKTval = .Cells(r, 18): c = "R"
                       strResolution = .Cells(r, 19): c = "S"
                    
                       '**END new Position mapping**
           
                            If strPfID = "Nobreaks" Then
                            rs6.Open "tblRecent", CurrentProject.Connection, adOpenStatic,_
adLockOptimistic
	
                                    If (rs6.Supports(adAddNew)) Then
                                        rs6.AddNew
                                        rs6.Fields("FundName") = strFundName
                                        rs6.Update
                                    End If
                                    intFundUp = intFundUp + 1
                                    rs6.Close
                                    BreakList.Requery
                            GoTo 99
                           
                            End If
                      
                       If isNothing(strFundName) Then
                        x = x
                       End If
                       'empty file with no breaks
                  
                      
                       If Not isNothing(strFundName) And IsDate(strTXdate) Then
                           today = Date
                          
                           'insert into Access
                        rs.Open "Breaks2", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic
	
                        If (rs.Supports(adAddNew)) Then
                                rs.AddNew
                                rs.Fields("FundName") = strFundName
                                rs.Fields("PortID") = strPfID
                                rs.Fields("StmtDate") = strTXdate
                                rs.Fields("RecDate") = strRecDate
                                rs.Fields("PreparedBy") = strPreparedBy
                                rs.Fields("Accountant") = strAccountant
                                rs.Fields("Investment") = strInvestment
                                rs.Fields("SecID") = strSecID
                                rs.Fields("GVAquant") = intGVAquant
                                rs.Fields("BKRquant") = intBKRquant
                                rs.Fields("QuantDiff") = intdiff
                                rs.Fields("GVAprice") = intGVAprice
                                rs.Fields("BKRprice") = intBKRprice
                                rs.Fields("PriceDiff") = intPriceDiff
                                rs.Fields("GVAmktValue") = intGVAmktVal
                                rs.Fields("BKRmktValue") = intBKRmktVal
                                rs.Fields("MKTvalDiff") = intMKTvalDIF
                                rs.Fields("GVAbookMKTval") = intGVAbkMKTval
                                rs.Fields("Resolution") = strResolution
                                rs.Fields("Period") = strPeriod
                                rs.Update
                           
                            If strFundName2 <> strFundName Then
                                rs5.Open "tblRecent", CurrentProject.Connection,
_adOpenStatic, adLockOptimistic
	
                                    If (rs5.Supports(adAddNew)) Then
                                        rs5.AddNew
                                        rs5.Fields("FundName") = strFundName
                                        rs5.Update
                                        intFundUp = intFundUp + 1
                                    End If
                                    rs5.Close
                                    BreakList.Requery
                            End If
                            strFundName2 = strFundName
                           
                            End If
                            rs.Close
                        Else
                            'THROW BAD DATE ERROR
	
                        End If
 
   
                        If Not isNothing(strFundName) And IsDate(strTXdate) And_
Not isNothing(intdiff) Then
	
                            today = Date
                           
                        ' dvb comments at bottom
                            strSql = "SELECT * FROM tblSave WHERE PortID='" & strPfID & "' AND_
Investment='" & strInvestment & "' AND QuantDiff=" & intdiff
	
                            rs2.Open strSql, cn, adOpenStatic, adLockOptimistic
                       
                            If Not rs2.EOF Then
	
                                strdate = rs2.Fields("Start")
                                daysOS = DateDiff("d", strdate, today)
                                daysOS2 = Abs(daysOS)
                                 If (rs2.Supports(adUpdate)) Then
                                    rs2.Fields("DaysOS") = daysOS2
                                    rs2.Update
                                 End If
                               
                            Else
                               
                                daysOS = DateDiff("d", strTXdate, today)
                                daysOS2 = Abs(daysOS)
                                'Add item to tblSave w/ current stmt date (already below)
	
                                rs3.Open "tblSave", CurrentProject.Connection, adOpenStatic,_
adLockOptimistic
	
                                If (rs3.Supports(adAddNew)) Then
                                    rs3.AddNew
                                    rs3.Fields("FundName") = strFundName
                                    rs3.Fields("Period") = strPeriod
                                    rs3.Fields("PortID") = strPfID
                                    rs3.Fields("StmtDate") = strTXdate
                                    rs3.Fields("RecDate") = strRecDate
                                    rs3.Fields("PreparedBy") = strPreparedBy
                                    rs3.Fields("Accountant") = strAccountant
                                    rs3.Fields("Investment") = strInvestment
                                    rs3.Fields("SecID") = strSecID
                                    rs3.Fields("GVAquant") = intGVAquant
                                    rs3.Fields("BKRquant") = intBKRquant
                                    rs3.Fields("QuantDiff") = intdiff
                                    rs3.Fields("GVAprice") = intGVAprice
                                    rs3.Fields("BKRprice") = intBKRprice
                                    rs3.Fields("PriceDiff") = intPriceDiff
                                    rs3.Fields("GVAmktValue") = intGVAmktVal
                                    rs3.Fields("BKRmktValue") = intBKRmktVal
                                    rs3.Fields("MKTvalDiff") = intMKTvalDIF
                                    rs3.Fields("GVAbookMKTval") = intGVAbkMKTval
                                    rs3.Fields("Resolution") = strResolution
                                    rs3.Fields("Start") = strTXdate
                                    rs3.Fields("DaysOS") = daysOS2
                                    rs3.Update
                                End If
                                rs3.Close
                            End If
                            rs2.Close
                        End If 'new end if for save
99
	
                        Next
                    End With
            End If
            xlBook.Close
            'xlApp.Quit
        End With
        xlApp.Quit
        Set xlApp = Nothing
        Set xlBook = Nothing
        Set xlSheet = Nothing
    Next
    lblFundUp.Caption = intFundUp
    Set rs = Nothing
    Set rs2 = Nothing
    Set fso = Nothing
    Set rs3 = Nothing
    Set rs4 = Nothing
    Set rs5 = Nothing
    Set rs6 = Nothing
Err_Exit:
	
DoCmd.Hourglass (0)
Exit Sub
Err_Handler:
    DoCmd.Hourglass (0)
    MsgBox ("Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf &_
"Location: " & VBWPROJECT & "." & VBWMODULE & "."
& VBWPROCEDURE & vbCrLf & "Line " & Erl & vbCrLf & "File: " &_
File & vbCrLf & "Excel Row: " & r)
	
Exit Sub
End Sub 'End Function
'***************************************
	
'**** 1. CREATE BreakReport ************
'***************************************
Sub GenerateBreakReport()
On Error GoTo Err_Handler
	
    If IsDate(txtAsOfDate) = False Then
        MsgBox ("Please enter a valid 'As Of Date'")
        GoTo Err_Exit
    End If
 
    DoCmd.SetWarnings (0)
    DoCmd.Hourglass (0)
   
    Dim db As Database, rs As Recordset
    Dim mdaT1() As Variant
    Dim mdaT2() As Variant
    Dim mdaT3() As Variant
    Dim mdaT4() As Variant
'    Dim mdaT5() As Variant
    strMonth = Month(txtAsOfDate)
	
    strYear = Year(txtAsOfDate)
    strDay = Day(txtAsOfDate)
    If Len(strMonth) = 1 Then strMonth = "0" & strMonth
    strPeriod = strYear & "." & strMonth
   
   
    Set db = CurrentDb
        If MnthOutput.Value = True Then
            strSql = "SELECT * FROM tblSave WHERE Period=" & strPeriod
        Else
            strSql = "SELECT * FROM tblSave"
        End If
    Set rs = db.OpenRecordset(strSql, dbOpenSnapshot)
   
    rs.MoveLast
    rs.MoveFirst
    rc = rs.RecordCount
   
    mdaT1r = 1
    mdaT2r = 1
    mdaT3r = 1
    mdaT4r = 1
   
    ReDim mdaT1(rc + 10, 15)
    ReDim mdaT2(rc + 10, 15)
    ReDim mdaT3(rc + 10, 15)
    ReDim mdaT4(rc + 10, 15)
   
    'tab1
    mdaT1(mdaT1r, 1) = "Position Break Summary (No Resolution)"
    mdaT1r = mdaT1r + 1
    mdaT1(mdaT1r, 1) = "'" & MonthName(strMonth, False) & " " & strYear
    mdaT1r = mdaT1r + 2
    mdaT1(mdaT1r, 1) = "0 to 7 days OS"
    mdaT1(mdaT1r, 2) = "8 to 30 days OS"
    mdaT1(mdaT1r, 3) = "31 to 60 days OS"
    mdaT1(mdaT1r, 4) = "61 to 90 days OS"
    mdaT1(mdaT1r, 5) = "+90 days OS"
     mdaT1r = mdaT1r + 1
    mdaT1(mdaT1r, 1) = 0
    mdaT1(mdaT1r, 2) = 0
    mdaT1(mdaT1r, 3) = 0
    mdaT1(mdaT1r, 4) = 0
    mdaT1(mdaT1r, 5) = 0
     
    'tab2
    mdaT2(mdaT2r, 1) = "Postion Break Summary Details (No Resolution)"
    mdaT2r = mdaT2r + 1
    mdaT2(mdaT2r, 1) = "'" & MonthName(strMonth, False) & " " & strYear
    mdaT2r = mdaT2r + 2
    mdaT2(mdaT2r, 1) = "Fund Name"
    mdaT2(mdaT2r, 2) = "Portfolio ID"
    mdaT2(mdaT2r, 3) = "Stmt Date"
    mdaT2(mdaT2r, 4) = "Days OS"
    mdaT2(mdaT2r, 5) = "Quantity Difference"
    mdaT2(mdaT2r, 6) = "Price Difference"
    mdaT2(mdaT2r, 7) = "Market Value Difference"
    mdaT2(mdaT2r, 8) = "Prepared By"
    mdaT2(mdaT2r, 9) = "Accountant"
    'mdaT2(mdaT2r, 14) = "Resolution"
   
    mdaT2r = mdaT2r + 1
   
 'tab 3
 
    mdaT3(mdaT3r, 1) = "Postion Breaks Over 90 Days (All)"
    mdaT3r = mdaT3r + 1
    mdaT3(mdaT3r, 1) = "'" & MonthName(strMonth, False) & " " & strYear
    mdaT3r = mdaT3r + 2
    mdaT3(mdaT3r, 1) = "Fund Name"
    mdaT3(mdaT3r, 2) = "Portfolio ID"
    mdaT3(mdaT3r, 3) = "Stmt Date"
    mdaT3(mdaT3r, 4) = "Days OS"
    mdaT3(mdaT3r, 5) = "Quantity Difference"
    mdaT3(mdaT3r, 6) = "Price Difference"
    mdaT3(mdaT3r, 7) = "Market Value Difference"
    mdaT3(mdaT3r, 8) = "Prepared By"
    mdaT3(mdaT3r, 9) = "Accountant"
    'mdaT2(mdaT2r, 14) = "Resolution"
    mdaT3r = mdaT3r + 1
    
'tab 4
    mdaT4(mdaT4r, 1) = "Postion Breaks Over 100K (All)"
	
    mdaT4r = mdaT4r + 1
    mdaT4(mdaT4r, 1) = "'" & MonthName(strMonth, False) & " " & strYear
    mdaT4r = mdaT4r + 2
    mdaT4(mdaT4r, 1) = "Fund Name"
    mdaT4(mdaT4r, 2) = "Portfolio ID"
    mdaT4(mdaT4r, 3) = "Stmt Date"
    mdaT4(mdaT4r, 4) = "Days OS"
    mdaT4(mdaT4r, 5) = "Quantity Difference"
    mdaT4(mdaT4r, 6) = "Price Difference"
    mdaT4(mdaT4r, 7) = "Market Value Difference"
    mdaT4(mdaT4r, 8) = "Prepared By"
    mdaT4(mdaT4r, 9) = "Accountant"
    'mdaT2(mdaT2r, 14) = "Resolution"
    mdaT4r = mdaT4r + 1
    
    
    
	
    
    Do While Not rs.EOF
   
     
        strFundName = rs.Fields("FundName")
        strPfID = rs.Fields("PortID")
        strTXdate = rs.Fields("StmtDate")
        strRecDate = rs.Fields("RecDate")
        strPreparedBy = rs.Fields("PreparedBy")
        strAccountant = rs.Fields("Accountant")
        strInvestment = rs.Fields("Investment")
        strSecID = rs.Fields("SecID")
        intGVAquant = rs.Fields("GVAquant")
        intBKRquant = rs.Fields("BKRquant")
        intdiff = rs.Fields("QuantDiff")
        intGVAprice = rs.Fields("GVAprice")
        intBKRprice = rs.Fields("BKRprice")
        intPriceDiff = rs.Fields("PriceDiff")
        intGVAmktVal = rs.Fields("GVAmktValue")
        intBKRmktVal = rs.Fields("BKRmktValue")
        intMKTvalDIF = rs.Fields("MKTvalDiff")
        intGVAbkMKTval = rs.Fields("GVAbookMKTval")
        strResolution = rs.Fields("Resolution")
        daysOS2 = rs.Fields("DaysOS")
       
  
     
        'tab1
        If daysOS2 <= 7 And isNothing(strResolution) Then
            mdaT1(mdaT1r, 1) = mdaT1(mdaT1r, 1) + 1
        ElseIf daysOS2 <= 30 And isNothing(strResolution) Then
            mdaT1(mdaT1r, 2) = mdaT1(mdaT1r, 2) + 1
        ElseIf daysOS2 <= 60 And isNothing(strResolution) Then
            mdaT1(mdaT1r, 3) = mdaT1(mdaT1r, 3) + 1
        ElseIf daysOS2 <= 90 And isNothing(strResolution) Then
            mdaT1(mdaT1r, 4) = mdaT1(mdaT1r, 4) + 1
        ElseIf isNothing(strResolution) Then
            mdaT1(mdaT1r, 5) = mdaT1(mdaT1r, 5) + 1
        End If
       
        'tab2
        If isNothing(strResolution) Then
            mdaT2(mdaT2r, 1) = strFundName
            mdaT2(mdaT2r, 2) = strPfID
            mdaT2(mdaT2r, 3) = strTXdate
            mdaT2(mdaT2r, 4) = daysOS2
            mdaT2(mdaT2r, 5) = intdiff
            mdaT2(mdaT2r, 6) = intPriceDiff
            mdaT2(mdaT2r, 7) = intMKTvalDIF
            mdaT2(mdaT2r, 8) = strPreparedBy
            mdaT2(mdaT2r, 9) = strAccountant
           ' mdaT2(mdaT2r, 8) = "USD"
           ' mdaT2(mdaT2r, 9) = strRecDate
           ' mdaT2(mdaT2r, 10) = strReccedDate
            'mdaT2(mdaT2r, 11) = strPreparedBy
            'mdaT2(mdaT2r, 12) = strAcctGroup
            'mdaT2(mdaT2r, 13) = strAccountant
            'mdaT2(mdaT2r, 14) = strResolution
             mdaT2r = mdaT2r + 1
        End If
        'tab3
       
	
        If daysOS2 >= 90 Then
            mdaT3(mdaT3r, 1) = strFundName
            mdaT3(mdaT3r, 2) = strPfID
            mdaT3(mdaT3r, 3) = strTXdate
            mdaT3(mdaT3r, 4) = daysOS2
            mdaT3(mdaT3r, 5) = intdiff
            mdaT3(mdaT3r, 6) = intPriceDiff
            mdaT3(mdaT3r, 7) = intMKTvalDIF
            mdaT3(mdaT3r, 8) = strPreparedBy
            mdaT3(mdaT3r, 9) = strAccountant
            mdaT3r = mdaT3r + 1
        End If
'tab 4
        If intMKTvalDIF > 100000 Then
            mdaT4(mdaT4r, 1) = strFundName
            mdaT4(mdaT4r, 2) = strPfID
            mdaT4(mdaT4r, 3) = strTXdate
            mdaT4(mdaT4r, 4) = daysOS2
            mdaT4(mdaT4r, 5) = intdiff
            mdaT4(mdaT4r, 6) = intPriceDiff
            mdaT4(mdaT4r, 7) = intMKTvalDIF
            mdaT4(mdaT4r, 8) = strPreparedBy
            mdaT4(mdaT4r, 9) = strAccountant
            mdaT4r = mdaT4r + 1
        End If
        rs.MoveNext
	
       
    Loop
    rs.Close
    Set rs = Nothing
	
'**************************************
'** ** ** ** OUTPUT TO .XLS ** ** ** **
'**************************************
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheetT1 As Excel.Worksheet
Dim xlSheetT2 As Excel.Worksheet
Dim xlSheetT3 As Excel.Worksheet
	
xlT1r = mdaT1r
xlT2r = mdaT2r
xlT3r = mdaT3r
xlT4r = mdaT4r
mdaT1r = 1: mdaT1c = 1
	
mdaT2r = 1: mdaT2c = 1
mdaT3r = 1: mdaT3c = 1
mdaT4r = 1: mdaT4c = 1
'mdaT5r = 1: mdaT5c = 1
Set xlApp = New Excel.Application
	
With xlApp
    xlApp.Visible = True
    Set xlBook = .Workbooks.Add
   
 
    Set xlSheetT2 = xlBook.Worksheets.Add
    With xlSheetT2
        .Name = "Break Summary Details"
       
        For mdaT2r = 1 To xlT2r
            For mdaT2c = 1 To 15
                .Cells(mdaT2r, mdaT2c).Value = mdaT2(mdaT2r, mdaT2c)
            Next
        Next
       
        'formats cells in .xls
       
        .Columns().Font.Name = "Arial"
        .Columns().Font.Size = 10
        .Columns().AutoFit
        .Rows(1).Font.Bold = True
        .Rows(4).Font.Bold = True
       
        Call Common.setupPage(xlSheetT2)
        .Columns("A:J").EntireColumn.AutoFit
        .PageSetup.Orientation = xlLandscape
    End With
   
    'tab1
    Set xlSheetT1 = xlBook.Worksheets.Add
    With xlSheetT1
        .Name = "Position Break Summary"
       
        For mdaT1r = 1 To xlT1r
            For mdaT1c = 1 To 15
                .Cells(mdaT1r, mdaT1c).Value = mdaT1(mdaT1r, mdaT1c)
            Next
        Next
       
        'formats cells in .xls
      
        .Columns().Font.Name = "Arial"
        .Columns().Font.Size = 10
        .Columns().AutoFit
        .Rows(1).Font.Bold = True
        .Rows(4).Font.Bold = True
       
        Call Common.setupPage(xlSheetT1)
        .Columns("A:J").EntireColumn.AutoFit
        .PageSetup.Orientation = xlLandscape
   
End With
Set xlSheetT4 = xlBook.Worksheets.Add
	
    With xlSheetT4
        .Name = "Over 100K"
       
        For mdaT4r = 1 To xlT4r
            For mdaT4c = 1 To 10
                .Cells(mdaT4r, mdaT4c).Value = mdaT4(mdaT4r, mdaT4c)
            Next
        Next
       
        'formats cells in .xls
      
        .Columns().Font.Name = "Arial"
        .Columns().Font.Size = 10
        .Columns().AutoFit
        .Rows(1).Font.Bold = True
        .Rows(4).Font.Bold = True
       
        Call Common.setupPage(xlSheetT1)
        .Columns("A:J").EntireColumn.AutoFit
        '.PageSetup.Orientation = xlLandscape
    End With
Set xlSheetT3 = xlBook.Worksheets.Add
	
    With xlSheetT3
        .Name = "Over 90 Days"
       
        For mdaT3r = 1 To xlT3r
            For mdaT3c = 1 To 15
                .Cells(mdaT3r, mdaT3c).Value = mdaT3(mdaT3r, mdaT3c)
            Next
        Next
       
        'formats cells in .xls
      
        .Columns().Font.Name = "Arial"
        .Columns().Font.Size = 10
        .Columns().AutoFit
        .Rows(1).Font.Bold = True
        .Rows(4).Font.Bold = True
       
        Call Common.setupPage(xlSheetT1)
        .Columns("A:J").EntireColumn.AutoFit
        .PageSetup.Orientation = xlLandscape
    End With
End With
Err_Exit:
	
DoCmd.Hourglass (0)
Exit Sub
	
Err_Handler:
    DoCmd.Hourglass (0)
    MsgBox ("Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & "Location: " &_
VBWPROJECT & "." & VBWMODULE & "." & VBWPROCEDURE & vbCrLf & "Line " & Erl)
	
    Exit Sub
End Sub
Function SheetExists(SheetName As String, xlBook As Object) As Boolean
	
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(xlBook.Sheets(SheetName).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function
Function getAmountInUSD(strAmount, strCurr, strPeriod)
	
    If strCurr = "USD" Then
        getAmountInUSD = strAmount: Exit Function
    Else
        Set cn = openCN()
        Dim rs1 As ADODB.Recordset
        Set rs1 = New ADODB.Recordset
        strSql1 = "SELECT Rate FROM Rates WHERE Currency='" & strCurr & "' AND Period=" & strPeriod
        rs1.Open strSql1, cn, adOpenStatic, adLockOptimistic
        If Not rs1.EOF Then
            strRate = rs1.Fields(0)
        End If
        Call closeRS(rs1)
        Call closeCN(cn)
       
        getAmountInUSD = (strAmount * strRate): Exit Function
    End If
End Function
Private Sub Form_Load()
	
   
    strSql = "DELETE FROM tblRecent"
    CurrentProject.Connection.Execute strSql
    strSql = "DELETE FROM tblNotUploaded"
    CurrentProject.Connection.Execute strSql
    DeleteList.Requery
   
    lblMaster.Caption = Listing.ListCount
   
End Sub
Private Sub Listing_Click()
End Sub
Private Sub ListPage_Click()
	
strFundNm.SetFocus
End Sub
Private Sub MnthOutput_Click()
	
txtAsOfDate.SetFocus
MnthOutput.Value = True
AllOutput.Value = False
End Sub
	
Private Sub comments()
    'dvb.. this opens the table tblSave without a where clause. 'rs2' is the recordset
'object that you can iterate through.
	
     'rs2.Open "tblSave", CurrentProject.Connection, adOpenStatic, adLockOptimistic
                           
     'dvb.. executes a select query but doesn't DO anything. typically an Execute is
'used for Insert, Update and Delete queries.... they don't return a record set.
	
     'strSql = "SELECT * FROM tblSave WHERE PortID='" & strPfID & "' AND Investment='" _
& strInvestment & "' AND QuantDiff=" & intdiff
	
     'CurrentProject.Connection.Execute strSql                           
                           
      'strSql = "SELECT * FROM tblSave WHERE PortID='" & strPfID & "' AND Investment='"_
& strInvestment & "' AND QuantDiff=" & intdiff
	
      'rs2.Open strSql, cn, adOpenStatic, adLockOptimistic
End Sub
Private Sub PrintMissing_Click()
	
    txtAsOfDate.SetFocus
 
   
    DoCmd.OpenTable "tblNotUploaded"
    DoCmd.SelectObject acTable, "tblNotUploaded"
    DoCmd.PrintOut
    DoCmd.Close acTable, "tblNotUploaded"
	
 
End Sub