![Excel Consulting, Development and Training [Expert Consultants]](https://www.excelhelp.com/wp-content/themes/excelhelp-opt7/assets/img/excelhelp-logo.png){kind=logo}
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