SQL Server Integration

SQL Server Integration using VBA

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:\Department\CTS-Accountants\PAU Group\MIS\Position 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

Sitemap | Privacy | Terms
Microsoft ® and Microsoft Excel ® are registered trademarks of Microsoft Corporation.
Copyright 2011 ExcelHelp.com All rights reserved
More Info (+)

Consulting and Training Services You Can Count On

Are you in search of a custom training or consulting solution for your business? Look no further. As leaders in the industry, Excel Help is here to offer you the best and most affordable solution for your business needs. We understand your business, which gives us the edge over other services when administering training and performing consulting services for your business. When you need professional help you can count on, we are standing by.

Excel Help Offers Services Such As:

Excel & Office Consulting-Get help from an MS Excel consultant who will provide you with the solution and training you need to master tasks with Microsoft Excel & Office. From tailored spreadsheets to custom reports-we've got you covered.

On-Demand. An alternative to a full-time employee-Get help from an Excel programmer who will work only when you need them to and is backed by our lifetime guarantee!

Excel Training-Excel online training or excel on site training-so you get the assistance you need, when you need it most.

Free Excel Guide-To give you tips and tricks to help you master even the most difficult excel tasks.

And More!

When you're ready to create a higher level of efficiency for your office, we are here to help!

A Proven Track Record You Can Count On

At Excel Help, we have a long history of helping businesses large and small with various business needs. We create a customized approach to training, consulting, and many other services so your business will benefit. From the best microsoft excel consultant choices to the highest level of excel online training, you will find everything you need right here. We have helped businesses around the world and are eager to help you with any excel or office training needs you have. When you want professionalism, industry expertise, and results-we are the right choice.

Our Excel Consulting Services Include:

Excel Macros & Excel Formulas

Excel Dashboards

Excel Report Automation

Excel Custom Forms

Excel Pivot Tables

Excel Advanced Charting

Excel Custom Templates

And Many More Options With the Help of One of Our Excel Consultant Professionals.

Access Consulting Options Include:

Access Database Design

Access Administration

MS Access Custom Reporting

MS Access Performance Tuning

MS Access Data Imports

SQL Server

Database System Integration

Excel Training Includes Options Such As:

MS Excel Online Training Classes

MS Excel On Site Training for Beginners, Intermediates, and Experts

MS Excel Private Group Training

MS Excel One-on-One Training

With a comprehensive level of service to meet any business needs, we are standing by to help.

Find Out How Excel Help Can Save You Money Today

With our approach to training and consulting, you will be able to create a highly efficient business environment that will achieve long-lasting results. When you invest in our services, your reward will be longevity in the marketplace as you position yourself to meet the demands of a constantly changing economy. With the right tools, your business can save money in the long-term by becoming more efficient than ever. When you're ready to find out how Excel Help can improve your company, feel free to contact us-our team of experts is standing by!