Integrating Excel and C#

How to do the same stuff in Excel and C#

Monday, September 5, 2016

modApp

Option Compare Database
Option Explicit
#Const DEBUG_MODE = 1
#Const PROD_MODE = 0
#Const APP_MODE = PROD_MODE
Public Const msMODULE As String = "modApp"

'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function Login() As Boolean
Const ssource As String = "Login"
Dim varUserAccessLevel As Variant
Dim strCurrentUser As String

On Error GoTo ErrorHandler

strCurrentUser = getWindowsUserId()
varUserAccessLevel = DLookup("UserAccessLevel", "SecurityUser", "[Name]=" & "'" & strCurrentUser & "'")
If IsNull(varUserAccessLevel) Then
    TempVars.Add "UserAccessLevel", UserRole.ReadOnly
    MsgBox "You currently are not in the system and will therefore be assigned minimal rights as a Read Only user.", _
        vbInformation
    Login = True
Else
    TempVars.Add "UserAccessLevel", CInt(varUserAccessLevel)
    Login = True
End If
  
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function



'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function loadHistory(ByRef LV As CustomControl, ByVal lngFeedId As Long) As Boolean
Const ssource As String = "loadHistory"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

strSQL = "SELECT FeedHistoryID, COB_Date,[Start] as StartTime, [End] as EndTime," & _
    "RecordCount as RecordCount2, null AS elapsedtime, DateCreated, " & _
    "UserCreated, DateModified, UserModified," & _
    " FS.Name,FH.VersionNo " & _
    " FROM FeedHistory FH INNER JOIN FeedStatus FS " & _
    " ON FH.FeedStatusID=FS.FeedStatusID " & _
    " WHERE FeediD=" & lngFeedId & _
    " ORDER BY COB_Date,DateCreated "


    'Debug.Print strSQL
    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adOpenDynamic
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection
    
    LV.ListItems.Clear
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "COB_Date", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "StartTime", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "EndTime", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "No of recs", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "ElapsedTime", 0, lvwColumnRight
    LV.ColumnHeaders.Add , , "DateCreated", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "UserCreated", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "DateModified", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "UserModified", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Status", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Version No", 1440, lvwColumnRight
    
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("FeedHistoryID").Value))
           With objli
                .SubItems(FeedHistoryDetail.COB_Date) = Nz(rs.Fields("COB_Date").Value)
                .SubItems(FeedHistoryDetail.StartTime) = Nz(rs.Fields("StartTime").Value)
                .SubItems(FeedHistoryDetail.EndTime) = Nz(rs.Fields("EndTime").Value)
                .SubItems(FeedHistoryDetail.RecordCount) = Nz(rs.Fields("RecordCount2").Value)
                .SubItems(FeedHistoryDetail.ElapsedTime) = Nz(rs.Fields("ElapsedTime").Value)
                .SubItems(FeedHistoryDetail.DateCreated) = Nz(rs.Fields("DateCreated").Value)
                .SubItems(FeedHistoryDetail.UserCreated) = Nz(rs.Fields("UserCreated").Value)
                .SubItems(FeedHistoryDetail.DateModified) = Nz(rs.Fields("DateModified").Value)
                .SubItems(FeedHistoryDetail.UserModified) = Nz(rs.Fields("UserModified").Value, "")
                .SubItems(FeedHistoryDetail.FeedStatus) = Nz(rs.Fields("Name").Value)
                .SubItems(FeedHistoryDetail.FeedStatus + 1) = Nz(rs.Fields("VersionNo").Value)
                
            End With
            rs.MoveNext
        Loop
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function loadTradeDetail(ByRef LV As CustomControl, ByVal COB_Date As Date, _
    intVersionNo As Integer, _
    intClientID As Integer) As Boolean
    
Const ssource As String = "loadTradeDetail"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

'strsql = "SELECT DISTINCT P.PosRptID, (SELECT AID.AltID from AID WHERE AID.PosRptID=P.PosRptID AND " & _
    "AID.AltIDSrc='104' AND AID.VersionNo=" & _
    intVersionNo & ") AS Cusip" & "," & _
    "(SELECT Instrmt.Desc from Instrmt WHERE Instrmt.PosRptID=P.PosRptID AND Instrmt.VersionNo=" & _
        intVersionNo & ") AS Underlying, " & _
    "(SELECT Instrmt.MatDt from Instrmt WHERE Instrmt.PosRptID=P.PosRptID AND Instrmt.VersionNo=" & _
        intVersionNo & ") AS MaturityDate, " & _
    " null as Notational, P.SetPx AS [SettlementPrice], P.PriSetPx AS [PriorSettlementPrice], " & _
     "(SELECT Sum(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='ACPN' AND Amt.VersionNo=" & _
        intVersionNo & ") AS [AccruedCoupon]," & _
    "(SELECT Sum(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='CMTM' AND Amt.VersionNo=" & _
        intVersionNo & ") AS MTM " & _
    " FROM (PosRpt AS P INNER JOIN Pty ON P.PosRptID = Pty.PosRptID) " & _
        "INNER JOIN Client ON Pty.ID = Client.CMeID " & _
    " WHERE (P.BizDt =#" & COB_Date & "#" & _
    " AND P.VersionNo=" & intVersionNo & _
    " AND Client.ClientID=" & intClientID & ")" & _
    " ORDER BY 3 "

strSQL = "SELECT DISTINCT P.PosRptID," & _
    "(SELECT Instrmt.Desc from Instrmt WHERE Instrmt.PosRptID=P.PosRptID AND Instrmt.VersionNo=" & _
        intVersionNo & ") AS Underlying, (SELECT Instrmt.MatDt from Instrmt WHERE Instrmt.PosRptID=P.PosRptID AND Instrmt.VersionNo=" & intVersionNo & ") AS MaturityDate, "

strSQL = strSQL & " Qty.Long-Qty.Short as Notional, " & _
    "P.SetPx AS [SettlementPrice], P.PriSetPx AS [PriorSettlementPrice], " & _
     "(SELECT Sum(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='ACPN' AND Amt.VersionNo=" & _
        intVersionNo & ") AS [AccruedCoupon]," & _
    "(SELECT Sum(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='CMTM' AND Amt.VersionNo=" & _
        intVersionNo & ") AS MTM, "

strSQL = strSQL & "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='TVAR' AND Amt.VersionNo=" & _
        intVersionNo & ") AS [ResetToPar]," & _
     "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='ICPN' AND AMT.VersionNO=" & _
        intVersionNo & ") AS InitialCoupon, " & _
    "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='CPN' AND AMT.VersionNO=" & _
        intVersionNo & ") AS Coupon," & _
    "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='BANK' AND AMT.VersionNO=" & _
        intVersionNo & ") AS Banked, " & _
    "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='COLAT' AND AMT.VersionNO=" & _
        intVersionNo & ") AS COLAT, " & "(SELECT SUM(Amt.Amt) from Amt  WHERE Amt.PosRptID=P.PosRptID and Amt.Typ='CRES' AND AMT.VersionNO=" & intVersionNo & ") AS CRES " & _
    " FROM ((PosRpt AS P INNER JOIN Pty ON P.PosRptID = Pty.PosRptID) " & _
        " INNER JOIN Client ON Pty.ID = Client.CMeID) " & _
        " LEFT JOIN Qty ON P.PosRptID=Qty.PosRptID " & _
    " WHERE (P.BizDt =#" & COB_Date & "#" & _
    " AND P.VersionNo=" & intVersionNo & _
    " AND Client.ClientID=" & intClientID & ")" & _
    " ORDER BY 3 "

    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adLockReadOnly
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection
    
    LV.ListItems.Clear
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "Row", 720, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Underlying", 2880
    LV.ColumnHeaders.Add , , "Maturity Date", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Notional", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Settlement Price", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Prior Settlement Price", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Accrued Coupon", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "MTM", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Reset to Par", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Initial Coupon", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Cpn Settlement", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "VM Excess/Deficit", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Today's Total VM Req", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Total Cash Adj.", 1440, lvwColumnRight
    
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
            i = i + 1
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("PosRptID").Value))
           With objli
                .SubItems(TradeDetail.Row) = i
                .SubItems(TradeDetail.Underlying) = Nz(rs.Fields("Underlying").Value)
                .SubItems(TradeDetail.MaturityDate) = Nz(rs.Fields("MaturityDate").Value)
                .SubItems(TradeDetail.notational) = Format(Nz(rs.Fields("Notional").Value), "Standard")
                .SubItems(TradeDetail.SettlementPrice) = Format(Nz(rs.Fields("SettlementPrice").Value), "Standard")
                .SubItems(TradeDetail.PriorSettlementPrice) = Format$(Nz(rs.Fields("PriorSettlementPrice").Value), "Standard")
                .SubItems(TradeDetail.AccruedCpn) = Format$(Nz(rs.Fields("AccruedCoupon").Value), "Standard")
                .SubItems(TradeDetail.MTM) = Format$(Nz(rs.Fields("MTM").Value), "Standard")
                .SubItems(TradeDetail.ResetToPar) = Format$(Nz(rs.Fields("ResetToPar").Value), "Standard")
                .SubItems(TradeDetail.InitialCoupon) = Format$(Nz(rs.Fields("InitialCoupon").Value), "Standard")
                .SubItems(TradeDetail.CPNSettlement) = Format$(Nz(rs.Fields("Coupon").Value), "Standard")
                .SubItems(TradeDetail.VMExcess_Defecit) = Format$(Nz(rs.Fields("BANKed").Value), "Standard")
                .SubItems(TradeDetail.[Todays Total VM Req]) = Format$(Nz(rs.Fields("COLAT").Value), "Standard")
                .SubItems(TradeDetail.TotalCashAdj) = Format$(Nz(rs.Fields("CRES").Value), "Standard")
            End With
            rs.MoveNext
        Loop
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
    
End Function


'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function loadCashMovementHistory(ByRef LV As CustomControl, ByVal COB_Date As Date, _
    intClientID As Integer) As Boolean
Const ssource As String = "loadCashMovementHistory"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer


strSQL = "SELECT DailyWorkCashMovementID,COB_DATE, Amount, Approver,ApprovedDate,DateCreated, " & _
    "UserCreated,DateModified,UserModified," & _
    "TransactionType, ClientID,DailyWorkCalculationID" & _
    " FROM DailyWorkCashMovement " & _
    " WHERE ClientID=" & intClientID & _
    " AND COB_DATE <=#" & COB_Date & "#" & _
    " ORDER BY COB_DATE DESC "

    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adLockReadOnly
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection
    
    LV.ListItems.Clear
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "Value Date", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Amount", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Approver", 1440
    LV.ColumnHeaders.Add , , "ApprovedDate", 2160
    LV.ColumnHeaders.Add , , "Date Created", 2160, lvwColumnRight
    LV.ColumnHeaders.Add , , "User Created", 2160, lvwColumnRight
    LV.ColumnHeaders.Add , , "Date Modified", 2160, lvwColumnRight
    LV.ColumnHeaders.Add , , "User Modified", 2160
    LV.ColumnHeaders.Add , , "Transaction type", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Client ID", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "DailyWorkCalculation ID", 1440, lvwColumnRight
    
    
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
            i = i + 1
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("DailyWorkCashMovementID").Value))
           With objli
                .SubItems(DailyWorkCashMovementDetail.COB_Date) = Nz(rs.Fields("COB_DATE").Value)
                .SubItems(DailyWorkCashMovementDetail.Amount) = Format(Nz(rs.Fields("Amount").Value), "Standard")
                .SubItems(DailyWorkCashMovementDetail.Approver) = Nz(rs.Fields("Approver").Value)
                .SubItems(DailyWorkCashMovementDetail.ApprovedDate) = Nz(rs.Fields("ApprovedDate").Value)
                .SubItems(DailyWorkCashMovementDetail.DateCreated) = Nz(rs.Fields("DateCreated").Value)
                .SubItems(DailyWorkCashMovementDetail.UserCreated) = Nz(rs.Fields("UserCreated").Value)
                .SubItems(DailyWorkCashMovementDetail.DateModified) = Nz(rs.Fields("DateModified").Value)
                .SubItems(DailyWorkCashMovementDetail.UserModified) = Nz(rs.Fields("UserModified").Value)
                .SubItems(DailyWorkCashMovementDetail.TransactionType) = Nz(rs.Fields("TransactionType").Value)
                .SubItems(DailyWorkCashMovementDetail.ClientID) = Nz(rs.Fields("ClientID").Value)
                .SubItems(DailyWorkCashMovementDetail.ClientID + 1) = Nz(rs.Fields("DailyWorkCalculationID").Value)
            End With
            rs.MoveNext
        Loop
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
    
End Function



'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function loadCashMovement(ByRef LV As CustomControl, _
    ByVal COB_Date As Date, _
    intClientID As Integer) As Boolean
    
Const ssource As String = "loadCashMovement"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

strSQL = "SELECT DailyWorkCashMovementID, Amount, DateCreated,UserCreated,DateModified,UserModified " & _
    " FROM DailyWorkCashMovement " & _
    " WHERE COB_DATE=#" & COB_Date & "# AND " & _
    " ClientID=" & intClientID & _
    " ORDER BY DailyWorkCashMovementID "
    
    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adOpenDynamic
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection
    
    LV.ListItems.Clear
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "Amount", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Created On", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Created By", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Modified On", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Modified By", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "TransactionType", 1440
   
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
            i = i + 1
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("DailyWorkCashMovementID").Value))
           With objli
                
                .SubItems(CashMovementDetail.Amount) = Nz(rs.Fields("Amount").Value)
                .SubItems(CashMovementDetail.DateCreated) = Nz(rs.Fields("DateCreated").Value)
                .SubItems(CashMovementDetail.UserCreated) = Nz(rs.Fields("UserCreated").Value)
                .SubItems(CashMovementDetail.DateModified) = Nz(rs.Fields("DateModified").Value)
                .SubItems(CashMovementDetail.UserModified) = Nz(rs.Fields("UserModified").Value)
                .SubItems(CashMovementDetail.TransactionType) = 2 'TransactionType.Update
            End With
            rs.MoveNext
        Loop
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
    
End Function


'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will load the listview grid on the DailyWork form based on 2 parameters
'                   (1) COB-Date and (2) Region and (3) Version number
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================

Function loadHistoryDailyWork(ByRef LV As CustomControl, _
    ByVal asofDate As Date, _
    ByVal Region As Integer, _
    ByVal VersionNo As Integer, _
    Optional intClearingHouseIndicator As Integer) As Long
    
Const ssource As String = "loadHistoryDailyWork"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

'Dim objCatalog As ADOX.Catalog
'Dim objCmd As ADODB.Command
'Dim strQueryName As String

'strQueryName = "qryDailyWorkgetperCOB_Date"

'Set objCatalog = New ADOX.Catalog
'Set objCatalog.ActiveConnection = CurrentProject.Connection

'Set objCmd = New ADODB.Command
'Set objCmd = objCatalog.Procedures(strQueryName).Command
'objCmd.Parameters(0).Value = asofdate
'objCmd.Parameters(1).Value = Region
'objCmd.Parameters(2).Value = VersionNo

strSQL = "SELECT DailyWork.DailyWorkID, DailyWork.ClientID, Client.ClientName, " & _
    "DailyWorkStatus.Note, DailyWork.ApprovedDate, DailyWork.Approver," & _
    "DailyWorkCalculation.CashCollateralBalance, DailyWorkCalculation.EquityBalance, " & _
    "DailyWorkCalculation.DailyWorkCalculationID, DailyWork.VersionNo, DailyWorkCalculation.IMRequirement,DailyWorkCalculation.DailyWorkCalculationID" & _
    " FROM Client INNER JOIN (DailyWorkStatus INNER JOIN (DailyWorkCalculation RIGHT JOIN DailyWork ON (DailyWorkCalculation.COB_Date = DailyWork.COB_Date) AND (DailyWorkCalculation.ClientID = DailyWork.ClientID)) ON DailyWorkStatus.DailyWorkStatusID = DailyWork.DailyWorkStatusID) ON Client.ClientID = DailyWork.ClientID " & _
    " WHERE DailyWork.VersionNo = " & VersionNo & _
    " And DailyWork.COB_Date =#" & asofDate & "#" & _
    " And Client.ClientLocationID =" & Region & _
    " ORDER BY Client.ClientName, DailyWork.COB_Date DESC"

    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adLockReadOnly
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection

    LV.ListItems.Clear
    'Set rs = objCmd.Execute
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "ClientId", 0, lvwColumnRight
    LV.ColumnHeaders.Add , , "Client Name", 3500, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Status", 1440
    LV.ColumnHeaders.Add , , "Approved Date", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Approver", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Cash Collateral Bal", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Equity Bal", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "DailyWorkCalculationID", 0, lvwColumnRight
    LV.ColumnHeaders.Add , , "IM", 1440, lvwColumnRight
    'LV.ColumnHeaders.Add , , "DailyWorkCalculation ID", 1440, lvwColumnRight
   
    
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("DailyWorkID").Value))
           With objli
                .SubItems(DailyWorkDetail.ClientID) = Nz(rs.Fields("ClientID").Value)
                .SubItems(DailyWorkDetail.ClientName) = Nz(rs.Fields("ClientName").Value)
                .SubItems(DailyWorkDetail.DailyWorkStatus) = Nz(rs.Fields("Note").Value)
                .SubItems(DailyWorkDetail.ApprovedDate) = Nz(rs.Fields("ApprovedDate").Value)
                .SubItems(DailyWorkDetail.Approver) = Nz(rs.Fields("Approver").Value)
                .SubItems(DailyWorkDetail.CollateralBalance) = Format(Nz(rs.Fields("CashCollateralBalance").Value), "Standard")
                .SubItems(DailyWorkDetail.EquityBalance) = Format(Nz(rs.Fields("EquityBalance").Value), "Standard")
                .SubItems(DailyWorkDetail.DailyWorkCalculationID) = Nz(rs.Fields("DailyWorkCalculationID").Value)
                .SubItems(DailyWorkDetail.DailyWorkCalculationID + 1) = _
                    Format(Nz(rs.Fields("IMRequirement").Value), "Standard")
                '.SubItems(DailyWorkDetail.DailyWorkCalculationID + 2) = rs.Fields("DailyWorkCalculationID").Value
            End With
            rs.MoveNext
        Loop
        loadHistoryDailyWork = LV.ListItems.Count
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function



'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will load the listview grid on the DailyWork form based on 4 parameters
'                   (1) COB-Date and (2) Region and (3) Version number
'                   and (4) Client ID
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================

Function loadHistoryDailyWorkWithFilter(ByRef LV As CustomControl, _
    ByVal asofDate As Date, _
    ByVal Region As Integer, _
    ByVal VersionNo As Integer, _
    ByVal ClientID As Integer, _
    Optional intClearingHouseIndicator As Integer) As Long
    
Const ssource As String = "loadHistoryDailyWorkWithFilter"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

Dim objCatalog As ADOX.Catalog
Dim objCmd As ADODB.Command
Dim strQueryName As String

    
strQueryName = "qryDailyWorkgetperCOB_DateAndClientID"

'Set objCatalog = New ADOX.Catalog
'Set objCatalog.ActiveConnection = CurrentProject.Connection

''Set objCmd = New ADODB.Command
'Set objCmd = objCatalog.Procedures(strQueryName).Command
'objCmd.Parameters(0).Value = asofDate
'objCmd.Parameters(1).Value = Region
'objCmd.Parameters(2).Value = VersionNo
'objCmd.Parameters(3).Value = ClientID


    
    
strSQL = "SELECT DailyWork.DailyWorkID, DailyWork.ClientID, Client.ClientName, " & _
    "DailyWorkStatus.Note, DailyWork.ApprovedDate, DailyWork.Approver, " & _
    "DailyWorkCalculation.CashCollateralBalance, DailyWorkCalculation.EquityBalance," & _
    "DailyWorkCalculation.DailyWorkCalculationID, DailyWork.VersionNo, DailyWorkCalculation.IMRequirement " & _
    " FROM Client INNER JOIN (DailyWorkStatus INNER JOIN (DailyWorkCalculation RIGHT JOIN DailyWork ON (DailyWorkCalculation.COB_Date = DailyWork.COB_Date) AND (DailyWorkCalculation.ClientID = DailyWork.ClientID)) ON DailyWorkStatus.DailyWorkStatusID = DailyWork.DailyWorkStatusID) ON Client.ClientID = DailyWork.ClientID " & _
    " WHERE DailyWork.ClientID = " & ClientID & _
        " And DailyWork.VersionNo = " & VersionNo & _
        " And DailyWork.COB_Date = #" & asofDate & "#" & _
        " And Client.ClientLocationID = " & Region & _
    " ORDER BY Client.ClientName, DailyWork.COB_Date DESC;"

    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adLockReadOnly
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection



    LV.ListItems.Clear
    'Set rs = objCmd.Execute
    rs.Open strSQL, objConn, Options:=adCmdText
    
    LV.ColumnHeaders.Clear
    LV.ColumnHeaders.Add , , "ID", 0
    LV.ColumnHeaders.Add , , "ClientId", 720, lvwColumnRight
    LV.ColumnHeaders.Add , , "Client Name", 3500, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Status", 1440
    LV.ColumnHeaders.Add , , "Approved Date", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Approver", 1440, lvwColumnLeft
    LV.ColumnHeaders.Add , , "Cash Collateral Bal", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "Equity Bal", 1440, lvwColumnRight
    LV.ColumnHeaders.Add , , "DailyWorkCalculationID", 0, lvwColumnRight
    LV.ColumnHeaders.Add , , "IM", 1440, lvwColumnRight
    
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
           Set objli = LV.ListItems.Add(, , Nz(rs.Fields("DailyWorkID").Value))
           With objli
                .SubItems(DailyWorkDetail.ClientID) = Nz(rs.Fields("ClientID").Value)
                .SubItems(DailyWorkDetail.ClientName) = Nz(rs.Fields("ClientName").Value)
                .SubItems(DailyWorkDetail.DailyWorkStatus) = Nz(rs.Fields("Note").Value)
                .SubItems(DailyWorkDetail.ApprovedDate) = Nz(rs.Fields("ApprovedDate").Value)
                .SubItems(DailyWorkDetail.Approver) = Nz(rs.Fields("Approver").Value)
                .SubItems(DailyWorkDetail.CollateralBalance) = Format(Nz(rs.Fields("CashCollateralBalance").Value), "Standard")
                .SubItems(DailyWorkDetail.EquityBalance) = Format(Nz(rs.Fields("EquityBalance").Value), "Standard")
                .SubItems(DailyWorkDetail.DailyWorkCalculationID) = Nz(rs.Fields("DailyWorkCalculationID").Value)
                .SubItems(DailyWorkDetail.DailyWorkCalculationID + 1) = _
                    Format(Nz(rs.Fields("IMRequirement").Value), "Standard")
            End With
            rs.MoveNext
        Loop
        
        loadHistoryDailyWorkWithFilter = LV.ListItems.Count
    End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function


'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will populate for SentDailyWork listview with the following views:
'               (1) All (2) Sent or (3)Approved, (4) Held Back (5) Pending (6) Awaiting Approval
'
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function setFilteredForSentHistory(ByRef LV As CustomControl, _
    ByVal asofDate As Date, _
    iFilter As SentDailyWorkFilter, _
    intRegion As Integer, _
    ByVal intVersionNo As Integer) As Boolean
Const ssource As String = "setFilteredForSentHistory"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

Select Case iFilter
    Case SentDailyWorkFilter.All
        'strSQL = " SELECT null as BatchID, null as BatchTime, DailyWorkStatus.Note, DailyWork.ClientID, " & _
        " Client.ClientName, DailyWork.DailyWorkID" & _
        " FROM ((DailyWork INNER JOIN DailyWorkStatus ON DailyWork.DailyWorkStatusID = DailyWorkStatus.DailyWorkStatusID) INNER JOIN Client ON DailyWork.ClientID = Client.ClientID) LEFT JOIN SentDailyWork ON DailyWork.DailyWorkID = SentDailyWork.DailyWorkID " & _
        " WHERE DailyWork.COB_DATe=#" & Asofdate & "#" & _
        " AND Client.ClientLocationId=" & intRegion & _
        " ORDER BY Client.ClientName"
        
        strSQL = " SELECT null as BatchID, null as BatchTime, DailyWorkStatus.Note, DailyWork.ClientID, " & _
        " Client.ClientName, DailyWork.DailyWorkID" & _
        " FROM ((DailyWork INNER JOIN DailyWorkStatus ON DailyWork.DailyWorkStatusID = DailyWorkStatus.DailyWorkStatusID) INNER JOIN Client ON DailyWork.ClientID = Client.ClientID) " & _
        " WHERE DailyWork.COB_DATe=#" & asofDate & "#" & _
        " AND Client.ClientLocationId=" & intRegion & _
        " AND DailyWork.VersionNo=" & intVersionNo & _
        " ORDER BY Client.ClientName"
        
    
    Case SentDailyWorkFilter.Sent
    
        strSQL = "SELECT Batch.BatchID, Batch.BatchTime, DailyWorkStatus.Note," & _
            "DailyWork.ClientID, Client.ClientName, DailyWork.DailyWorkID" & _
            " FROM Client INNER JOIN (DailyWorkStatus INNER JOIN (DailyWork INNER JOIN (Batch INNER JOIN SentDailyWork ON Batch.BatchID = SentDailyWork.BatchID) ON DailyWork.DailyWorkID = SentDailyWork.DailyWorkID) ON DailyWorkStatus.DailyWorkStatusID = DailyWork.DailyWorkStatusID) ON Client.ClientID = DailyWork.ClientID " & _
            " WHERE Batch.BatchID IN (" & _
            " SELECT Batch.BatchID " & _
            " FROM DailyWork INNER JOIN (Batch INNER JOIN SentDailyWork ON " & _
            " Batch.BatchID = SentDailyWork.BatchID) ON DailyWork.DailyWorkID = SentDailyWork.DailyWorkID " & _
            " WHERE DailyWork.COB_Date=#" & asofDate & "#) " & _
            " AND Client.ClientLocationId=" & intRegion & _
            " AND DailyWork.VersionNo=" & intVersionNo & _
            " ORDER BY Client.ClientName,Batch.BatchTime DESC"
        
    Case Else
        'Approved,Held Back, Pending. Awaiting Approval
       
        
       ' strSQL = " SELECT null as BatchID, null as BatchTime, DailyWorkStatus.Note, DailyWork.ClientID, " & _
        " Client.ClientName, DailyWork.DailyWorkID" & _
        " FROM ((DailyWork INNER JOIN DailyWorkStatus ON DailyWork.DailyWorkStatusID = DailyWorkStatus.DailyWorkStatusID) INNER JOIN Client ON DailyWork.ClientID = Client.ClientID) LEFT JOIN SentDailyWork ON DailyWork.DailyWorkID = SentDailyWork.DailyWorkID " & _
        " WHERE DailyWork.COB_DATe=#" & Asofdate & "#" & _
        " AND DailyWork.DailyWorkStatusID=" & iFilter & _
        " AND Client.ClientLocationId=" & intRegion & _
        " ORDER BY DailyWork.ClientID"
        
        
        'will get batch time
         strSQL = " SELECT null as BatchID, null as BatchTime, DailyWorkStatus.Note, DailyWork.ClientID, " & _
        " Client.ClientName, DailyWork.DailyWorkID" & _
        " FROM ((DailyWork INNER JOIN DailyWorkStatus ON DailyWork.DailyWorkStatusID = DailyWorkStatus.DailyWorkStatusID) INNER JOIN Client ON DailyWork.ClientID = Client.ClientID) " & _
        " WHERE DailyWork.COB_DATe=#" & asofDate & "#" & _
        " AND DailyWork.DailyWorkStatusID=" & iFilter & _
        " AND Client.ClientLocationId=" & intRegion & _
        " AND DailyWork.VersionNo=" & intVersionNo & _
        " ORDER BY Client.ClientName"
        
End Select


Set rs = New ADODB.Recordset
With rs
    .LockType = adLockOptimistic
    .CursorType = adOpenDynamic
End With

Set objConn = New ADODB.Connection
Set objConn = CurrentProject.Connection
    
LV.ListItems.Clear
rs.Open strSQL, objConn, Options:=adCmdText

LV.ColumnHeaders.Clear
LV.ColumnHeaders.Add , , "ID", 0
LV.ColumnHeaders.Add , , "Batch Id", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Batch Time", 1440, lvwColumnRight

LV.ColumnHeaders.Add , , "Client Id", 0, lvwColumnRight
LV.ColumnHeaders.Add , , "Client Name", 2880
LV.ColumnHeaders.Add , , "Status", 1440, lvwColumnCenter
LV.ColumnHeaders.Add , , "DailyWorkID", 0, lvwColumnRight

If Not (rs.EOF() And rs.BOF) Then
    Do While Not rs.EOF
       Set objli = LV.ListItems.Add(, , Nz(rs.Fields("BatchID").Value) + Nz(rs.Fields("DailyWorkID").Value))
       With objli
            .SubItems(SentDailyWork.BatchID) = Nz(rs.Fields("BatchID").Value)
            .SubItems(SentDailyWork.BatchTime) = Nz(rs.Fields("BatchTime").Value)
            .SubItems(SentDailyWork.ClientID) = Nz(rs.Fields("ClientId").Value)
            .SubItems(SentDailyWork.ClientName) = Nz(rs.Fields("ClientName").Value)
            .SubItems(SentDailyWork.Status) = Nz(rs.Fields("Note").Value)
            .SubItems(SentDailyWork.DailyWorkId) = Nz(rs.Fields("DailyWorkID").Value)
        End With
        rs.MoveNext
    Loop
End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function setFilteredForClientCollateral(ByRef LV As CustomControl, _
    ByVal asofDate As Date) As Boolean
Const ssource As String = "setFilteredForClientCollateral"

On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer
Dim objCatalog As ADOX.Catalog
Dim objCmd As ADODB.Command
Dim strQueryName As String

strQueryName = "qryClientCollateralgetperCOBDate"

Set objCatalog = New ADOX.Catalog
Set objCatalog.ActiveConnection = CurrentProject.Connection

Set objCmd = New ADODB.Command
Set objCmd = objCatalog.Procedures(strQueryName).Command
objCmd.Parameters(0).Value = asofDate

'step 2
LV.ListItems.Clear
Set rs = objCmd.Execute


LV.ColumnHeaders.Clear
LV.ColumnHeaders.Add , , "ID", 720
LV.ColumnHeaders.Add , , "Client Name", 2880
LV.ColumnHeaders.Add , , "Equity Balance Id", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Initial Margin", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Collateral Balance", 1440, lvwColumnRight


LV.ColumnHeaders.Add , , "Customer Today IM", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Customer Prior Day's IM", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Customer Prior Day MTM", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "Customer Today MTM", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "House Prior MTM", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "House Today MTM", 1440, lvwColumnRight


If Not (rs.EOF() And rs.BOF) Then
    Do While Not rs.EOF
       Set objli = LV.ListItems.Add(, , Nz(rs.Fields("ClientID").Value))
       With objli
            .SubItems(1) = Format(Nz(rs.Fields("ClientName").Value), MASK_MONEY)
            .SubItems(2) = Format(Nz(rs.Fields("EquityBalance").Value), MASK_MONEY)
            .SubItems(3) = Format(Nz(rs.Fields("InitialMargin").Value), MASK_MONEY)
            .SubItems(4) = Format(Nz(rs.Fields("CollateralBalance").Value), MASK_MONEY)
            .SubItems(5) = Format(Nz(rs.Fields("CustomerTodayIM").Value), MASK_MONEY)
            
            .SubItems(6) = Format(Nz(rs.Fields("CustomerPriorDaysIM").Value), MASK_MONEY)
            .SubItems(7) = Format(Nz(rs.Fields("CustomerPriorDayMTM").Value), MASK_MONEY)
            .SubItems(8) = Format(Nz(rs.Fields("CustomerTodayMTM").Value), MASK_MONEY)
            .SubItems(9) = Format(Nz(rs.Fields("HousePriorDayMTM").Value), MASK_MONEY)
            .SubItems(10) = Format(Nz(rs.Fields("HouseTodayMTM").Value), MASK_MONEY)
            
        End With
        rs.MoveNext
    Loop
End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function MarkDailyWorkAs(ByRef LV As CustomControl, iStatus As DailyWorkStatus) As Boolean
Const ssource As String = "MarkDailyWorkAs"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer
Dim bInTrans As Boolean
Dim lngUpdated As Long
Dim lngRecsAffected As Long

Set objConn = New ADODB.Connection
Set objConn = CurrentProject.Connection
DoCmd.Hourglass True
objConn.BeginTrans
For Each objli In LV.ListItems
    If objli.Selected Then
        'write sql statement
        If iStatus = 2 Then 'DailyWorkStatus.Approved
        
            strSQL = "UPDATE DailyWork " & _
                "SET DailyWorkStatusID=" & iStatus & _
                ",ApprovedDate=#" & Now() & "#," & _
                "Approver='" & getWindowsUserId() & "'" & _
                " WHERE DailyWorkID=" & objli.Text
                
        Else
            'strSQL = "UPDATE DailyWork " & _
                "SET DailyWorkStatusID=" & iStatus & _
                " WHERE DailyWorkID=" & objLI.Text
            strSQL = "UPDATE DailyWork " & _
                "SET DailyWorkStatusID=" & iStatus & _
                ",ApprovedDate=" & "null" & "," & _
                "Approver=" & "null" & _
                " WHERE DailyWorkID=" & objli.Text
            
        End If
    
        objConn.Execute strSQL, lngRecsAffected, adCmdText + adExecuteNoRecords
        lngUpdated = lngUpdated + 1
    End If
    bInTrans = True
Next

If bInTrans Then
    objConn.CommitTrans
Else
    objConn.RollbackTrans
End If

ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    DoCmd.Hourglass False
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function loadSecurityUserQueue(ByRef LV As CustomControl) As Boolean
Const ssource As String = "loadSecurityUserQueue"
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objli As ListItem
Dim i As Integer

Dim strQueryName As String

On Error GoTo ErrorHandler

Set rs = New ADODB.Recordset
'2-25 doesn't work do not know why
'Set rs = modADO.getAccessQueryResults("qrySecurityUserQueuegetAll")

strSQL = "SELECT SecurityUserQueue.SecurityUserId, SecurityUserQueue.Name, " & _
    "SecurityUserQueue.UserAccessLevel,  SecurityUserRole.Note AS UserLevelDescription," & _
    "SecurityUserQueue.TransactionType, TransactionType.Note AS TransactionTypeDescription," & _
    "SecurityUserQueue.DateCreated, SecurityUserQueue.UserCreated, " & _
    "SecurityUserQueue.DateModified, SecurityUserQueue.UserModified, " & _
    "SecurityUserQueue.Approver, SecurityUserQueue.ApprovedDate" & _
    " FROM (SecurityUserQueue INNER JOIN SecurityUserRole ON SecurityUserQueue.UserAccessLevel = SecurityUserRole.UserAccessLevel) INNER JOIN TransactionType ON SecurityUserQueue.TransactionType = TransactionType.TransactionTypeID " & _
    " ORDER BY Name "

Set rs = New ADODB.Recordset
With rs
    .LockType = adLockOptimistic
    .CursorType = adOpenDynamic
End With

Set objConn = New ADODB.Connection
Set objConn = CurrentProject.Connection

LV.ListItems.Clear

rs.Open strSQL, objConn, Options:=adCmdText

LV.ColumnHeaders.Clear
LV.ColumnHeaders.Add , , "ID", 0

LV.ColumnHeaders.Add , , "Name", 1440
LV.ColumnHeaders.Add , , "UserAccessLevel", 0
LV.ColumnHeaders.Add , , "Level", 1440
LV.ColumnHeaders.Add , , "Transactiontype", 0
LV.ColumnHeaders.Add , , "Type", 720, lvwColumnCenter
LV.ColumnHeaders.Add , , "Approved Date", 0, lvwColumnRight
LV.ColumnHeaders.Add , , "Approver", 0, lvwColumnLeft
LV.ColumnHeaders.Add , , "Date Created", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "User Created", 1440, lvwColumnLeft
LV.ColumnHeaders.Add , , "Date Modified", 1440, lvwColumnRight
LV.ColumnHeaders.Add , , "User Modified", 1440, lvwColumnLeft
   
    
If Not (rs.EOF() And rs.BOF) Then
    Do While Not rs.EOF
       Set objli = LV.ListItems.Add(, , Nz(rs.Fields("SecurityUserID").Value))
       With objli
            .SubItems(SecurityUserQueue.EmployeeName) = Nz(rs.Fields("Name").Value)
            .SubItems(SecurityUserQueue.UserAccessLevel) = Nz(rs.Fields("UserAccessLevel").Value)
            .SubItems(SecurityUserQueue.UserAccessLevelDescription) = Nz(rs.Fields("UserLevelDescription").Value)
            .SubItems(SecurityUserQueue.TransactionType) = Nz(rs.Fields("TransactionType").Value)
            .SubItems(SecurityUserQueue.TransactionTypeDescription) = Nz(rs.Fields("TransactionTypeDescription").Value)
            .SubItems(SecurityUserQueue.ApprovedDate) = Nz(rs.Fields("ApprovedDate").Value)
            .SubItems(SecurityUserQueue.Approver) = Nz(rs.Fields("Approver").Value)
            .SubItems(SecurityUserQueue.DateCreated) = Nz(rs.Fields("DateCreated").Value)
            .SubItems(SecurityUserQueue.UserCreated) = Nz(rs.Fields("UserCreated").Value)
            .SubItems(SecurityUserQueue.DateModified) = Nz(rs.Fields("DateModified").Value)
            .SubItems(SecurityUserQueue.UserModified) = Nz(rs.Fields("UserModified").Value)
        End With
        rs.MoveNext
    Loop
End If
    
loadSecurityUserQueue = True
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
    
End Function


Function loadTVSentDailyWork(ByRef tv As CustomControl) As Boolean
Const ssource As String = "loadTVSentDailyWork"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objNode As Node
Dim i As Integer
Dim asofDate As Date
Dim strQueryName As String

Set rs = New ADODB.Recordset

'Set rs = modADO.getAccessQueryResults("qryDailyWorkCOBDates")
Dim objCatalog As ADOX.Catalog
Dim objCmd As ADODB.Command



Set objCatalog = New ADOX.Catalog
Set objCatalog.ActiveConnection = CurrentProject.Connection

Set objCmd = New ADODB.Command
strQueryName = "qryDailyWorkCOBDates"
'handle parameters first

'kludge because it expects this parameter. Oh well
Set objCmd = objCatalog.Procedures(strQueryName).Command
objCmd.Parameters(0).Value = [Forms]![Preferences]![cboLocation]

'step 2
Set rs = objCmd.Execute


If Not (rs Is Nothing) Then
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
            asofDate = CDate(Mid(rs.Fields(0).Value, 1, 10))
            Set objNode = tv.Nodes.Add(, , "COB" & rs.Fields(0).Value, rs.Fields(0).Value)
            rs.MoveNext
        Loop
    End If
End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objNode = Nothing
    Set objCmd = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function loadTVClientCollateral(ByRef tv As CustomControl) As Boolean
Const ssource As String = "loadTVClientCollateral"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim objNode As Node
Dim i As Integer

Set rs = New ADODB.Recordset

Set rs = modADO.getAccessQueryResults("qryClientCollateralCOBDates")
If Not (rs Is Nothing) Then
    If Not (rs.EOF() And rs.BOF) Then
        Do While Not rs.EOF
            Set objNode = tv.Nodes.Add(, , "COB" & rs.Fields("Cob_dATE").Value, Format(rs.Fields("COB_DAte").Value, "mm/dd/yyyy"))
            rs.MoveNext
        Loop
    End If
End If
    
ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function getInquiryLineItems(ByRef lb As ListBox, ByVal lngParentId As Long) As Boolean
Const ssource As String = "getInquiryLineItems"
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim objConn As ADODB.Connection
Dim i As Integer
With lb
    .RowSourceType = "Value List"
    .RowSource = ""
    
    .ColumnHeads = True
    .ColumnCount = 11
    .ColumnWidths = "0 in;0 in;1.5 in;1.5 in;1.0 in;.5 in;.5 in;.5 in;.5 in;.5 in;3.5"
    .AddItem "InquiryLineItemId;EstimateID;LanguageSourceId; LanguageTargetId;InquiryTypeId; AVType;Units; Quantity; Rate; Amt;Note"
        
    strSQL = "SELECT InquiryLineItemId, EstimateID, " & _
            "CSTR([LanguageSourceId])" & " +'-'+ " & "[tblLanguage_1]![Note] AS LanguageSource, " & _
            "CSTR([LanguageTargetId])" & " +'-'+ " & "[tblLanguage]![Note] AS LanguageTarget, " & _
            "CSTR(InquiryTypeId) " & " +'-'+ " & "[InquiryType]![Note] AS InquiryType, " & _
            "AVType, " & _
            "Units, Quantity, Rate," & _
            "Quantity*Rate As Amount,InquiryLineItem.Note " & _
            " FROM tblLanguage AS tblLanguage_1 RIGHT JOIN (InquiryType INNER JOIN (tblLanguage RIGHT JOIN InquiryLineItem ON tblLanguage.LanguageCode = InquiryLineItem.LanguageSourceId) ON InquiryType.InquiryTypeCode = InquiryLineItem.InquiryTypeId) ON tblLanguage_1.LanguageCode = InquiryLineItem.LanguageTargetId" & _
            " WHERE InquiryLineItem.EstimateID = " & lngParentId & _
            " ORDER BY InquiryLineItem.InquiryLineItemId DESC"
            
            
    Set rs = New ADODB.Recordset
    With rs
        .LockType = adLockOptimistic
        .CursorType = adOpenDynamic
    End With
    
    Set objConn = New ADODB.Connection
    Set objConn = CurrentProject.Connection
    
    rs.Open strSQL, objConn, Options:=adCmdText
    If Not (rs.EOF() And rs.BOF) Then
        strSQL = ""
        Do While Not rs.EOF
            For i = 0 To rs.Fields.Count - 1
                strSQL = strSQL & Nz(rs.Fields(i)) & ";"
            Next
            strSQL = Mid(strSQL, 1, Len(strSQL) - 1)
            .AddItem strSQL
            strSQL = ""
            rs.MoveNext
        Loop
    End If
    
End With
getInquiryLineItems = True

ExitProc:
    On Error Resume Next
    Set rs = Nothing
    Set objConn = Nothing
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
End Function



Function getLVRowSourceProperty(LV As Object) As String
Const ssource As String = "getLVRowSourceProperty"
On Error GoTo ErrorHandler
Dim varItem As Variant
Dim i As Integer, strValue As String
If LV.ListItems.Count Then
    For i = 1 To LV.ListItems.Count
        strValue = strValue & LV.ListItems(i).Text & ";"
    Next
    strValue = Left(strValue, Len(strValue) - 1)
    getLVRowSourceProperty = strValue

End If
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If


End Function


Function setLVRowSourceProperty(ByRef LV As Object, ByVal strData As String) As Boolean
Const ssource As String = "setLVRowSourceProperty"
On Error GoTo ErrorHandler
Dim varItem As Variant
Dim aData As Variant
Dim objli As ListItem
Dim i As Integer, strValue As String
aData = Split(strData, ";")
LV.ListItems.Clear
LV.ColumnHeaders.Clear
LV.ColumnHeaders.Add , , "Language", LV.Width
For i = LBound(aData) To UBound(aData)
    Set objli = LV.ListItems.Add(, , aData(i))
Next

ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If


End Function



Function getUserSelections2(ByRef lb As ListBox) As Variant
Const ssource As String = "getBillingRatesOnly2"
On Error GoTo ErrorHandler
Dim varItem As Variant
Dim i As Integer, strValue As String
If lb.ListCount Then
    For i = 0 To lb.ListCount - 1
        strValue = strValue & lb.ItemData(i) & ";"
    Next
    strValue = Left(strValue, Len(strValue) - 1)
    getUserSelections2 = strValue
Else
    getUserSelections2 = Null
End If
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function
Function getUserSelections(ByRef lb As ListBox) As Variant
Const ssource As String = "getBillingRatesOnly"
On Error GoTo ErrorHandler
Dim varItem As Variant
Dim i As Integer, strValue As String
If lb.ItemsSelected.Count Then
    For Each varItem In lb.ItemsSelected
        strValue = strValue & lb.ItemData(varItem) & ","
    Next
    strValue = Left(strValue, Len(strValue) - 1)
    getUserSelections = strValue
Else
    getUserSelections = Null
End If
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Function setUserSelections(ByRef lb As ListBox, ByVal strValue As String) As Boolean
Const ssource As String = "setUserSelections"
On Error GoTo ErrorHandler

Dim i As Integer, j As Integer, aData As Variant, varItem As Variant
aData = Split(strValue, ",")

'12/7 bug fix to de-select prior selections

If lb.ItemsSelected.Count Then
    For Each varItem In lb.ItemsSelected
        lb.Selected(varItem) = False
    Next
End If

For i = LBound(aData) To UBound(aData)
    'search lb for a match
    For j = 0 To lb.ListCount - 1
        'match found so now selected in the lb
        If aData(i) = lb.ItemData(j) Then
            lb.Selected(j) = True
            Exit For
        End If
    Next
Next
        
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function


Public Function PickerGetSelections(ByVal strSourceName) As Boolean
Const ssource As String = "PickerGetSelections"
On Error GoTo ErrorHandler
DoCmd.OpenForm "frmPicker", acNormal, windowmode:=acDialog, _
    OpenArgs:=strSourceName
PickerGetSelections = True
ExitProc:
    On Error Resume Next
    DoCmd.Hourglass False
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function

Public Sub ListControlProps(ByRef frm As Form)
    Dim ctl As Control
    Dim prp As Property

    On Error GoTo props_err

    For Each ctl In frm.Controls
        Debug.Print ctl.Properties("Name")
        For Each prp In ctl.Properties
            Debug.Print vbTab & prp.Name & " = " & prp.Value
        Next prp
    Next ctl

props_exit:
    Set ctl = Nothing
    Set prp = Nothing
Exit Sub

props_err:
    If Err = 2187 Then
        Debug.Print vbTab & prp.Name & " = Only available at design time."
        Resume Next
    Else
        Debug.Print vbTab & prp.Name & " = Error Occurred: " & Err.Description
        Resume Next
    End If
End Sub


Public Sub ListProps(ByRef objAny As Object)
    
    Dim prp As Property

    On Error GoTo props_err
    
    Debug.Print ""
    Debug.Print "-----------------------"
    For Each prp In objAny.Properties
        Debug.Print vbTab & prp.Name & " = " & prp.Value
    Next prp
    

props_exit:
    
    Set prp = Nothing
Exit Sub

props_err:
    If Err = 2187 Then
        Debug.Print vbTab & prp.Name & " = Only available at design time."
        Resume Next
    Else
        Debug.Print vbTab & prp.Name & " = Error Occurred: " & Err.Description
        Resume Next
    End If
End Sub



Public Function ValidateLanguageControls(f As Form) As Boolean
Const ssource As String = "ValidateDateControls"
On Error GoTo ErrorHandler
If f.lvSource.ListItems.Count = 0 Then
    MsgBox "Need a source language", vbInformation, "Validate Language Controls"
    Exit Function
    
ElseIf (f.lvTarget.ListItems.Count = 0) Then
    MsgBox "Need a target language", vbInformation, "Validate Language Controls"
    Exit Function

ElseIf Not (f.lvTarget.ListItems.Count = f.lvTarget.ListItems.Count) Then
    MsgBox "Differing number of source languages and target languages;" & _
        " they must be equal to each other", vbInformation, "Validate Language Controls"
    Exit Function

Else
    ValidateLanguageControls = True
End If
ExitProc:
    On Error Resume Next
    
    Exit Function

ErrorHandler:
    
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
End Function

Function CreateDailyWorkWB(ByVal iClientID As Long, _
    ByVal strClientName As String, _
    ByVal COB_Date, _
    Optional bConfirm As Boolean = True) As Boolean
    
Const ssource As String = "CreateDailyWorkWB"
On Error GoTo ErrorHandler
Dim varItem As Variant
Dim i As Integer, strValue As String
Dim strMessage As String
Dim xlApp As Excel.Application
Dim wbSource As Excel.Workbook
Dim objRange As Excel.Range
Dim objWks As Excel.Worksheet
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim dblCME_CustomerTodayIM As Double
Dim dblCME_CustomerPriorDaysIM As Double
Dim dblCME_CustomerPriorDAYMTM As Double
Dim dblCME_CustomerTodayMTM As Double
Dim dblCME_HousePriorDAYMTM As Double
Dim dblCME_HouseTodayMTM As Double

Dim dblEquityBalance As Double
Dim dblInitialMargin As Double
Dim dblCollateralBalance As Double
Dim strTemplate As String
Dim strNewFileName As String
Dim objConn As ADODB.Connection

Const WKS_INPUT As String = "Input"

If bConfirm Then
    If Not vbYes = MsgBox("Sure you want to make a new daily workbook for client '" & _
        strClientName & "'" & vbNewLine & _
        "As of: : " & Format$(COB_Date, MASK_DATE), vbYesNo Or vbQuestion, "Confirm action") Then
        CreateDailyWorkWB = False
        Exit Function
    End If
End If

'open workbook first
DoCmd.Hourglass True

'Call SysCmd(acSysCmdSetStatus, "Creating Excel workbook")
Set xlApp = New Excel.Application
'strNewFileName = AddBS(APP_LOCAL_OUTPUT_PATH) & "Asof " & Format(COB_Date, "yyyymmdd") & _
    strClientName & ".xlsx"

strNewFileName = getAppPath() & "\Output\" & Format(COB_Date, "yyyymmdd") & _
    strClientName & ".xlsx"
strTemplate = getAppPath() & "\Input\" & "CME CCP Client Statement Model.xlsx"
        
Set wbSource = xlApp.Workbooks.Open(strTemplate, ReadOnly:=True)
Set objWks = wbSource.Worksheets(WKS_INPUT)


'will get from recordset
strSQL = "SELECT ClientCollateral.ClientCollateralId, ClientCollateral.EquityBalance, " & _
    " ClientCollateral.InitialMargin, ClientCollateral.CollateralBalance, " & _
    " ClientCollateral.CustomerTodayIM, ClientCollateral.CustomerPriorDaysIM, " & _
    " CustomerPriorDayMTM, CustomerTodayMTM,HousePriorDayMTM, " & _
    " ClientCollateral.HouseTodayMTM, ClientCollateral.ClientID, ClientCollateral.COB_Date " & _
    " FROM ClientCollateral " & _
    " WHERE ClientCollateral.ClientID=" & iClientID & _
    " AND ClientCollateral.COB_Date=# " & COB_Date & "#"
    
Set objConn = New ADODB.Connection
Set objConn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open strSQL, objConn, adOpenKeyset, adLockReadOnly
If Not rs.EOF Then
    dblInitialMargin = Nz(rs.Fields("InitialMargin").Value, 0)
    dblEquityBalance = Nz(rs.Fields("EquityBalance").Value, 0)
    dblCollateralBalance = Nz(rs.Fields("CollateralBalance").Value, 0)
    
    dblCME_CustomerTodayIM = Nz(rs.Fields("CustomertodayIM").Value, 0)
    dblCME_CustomerPriorDaysIM = Nz(rs.Fields("CustomerPriorDaysIM").Value, 0)
    dblCME_CustomerPriorDAYMTM = Nz(rs.Fields("CustomerPriorDayMTM").Value, 0)
    
    
    dblCME_CustomerTodayMTM = Nz(rs.Fields("CustomerTodayMTM").Value, 0)
    dblCME_HousePriorDAYMTM = Nz(rs.Fields("HousePriorDayMTM").Value, 0)
    dblCME_HouseTodayMTM = Nz(rs.Fields("HouseTodayMTM"), 0)
    
End If
Set rs = Nothing
Set objConn = Nothing
    
With wbSource
    .Names("Initial_Margin").RefersToRange.Value = dblInitialMargin
...
at 7:42 PM No comments:
Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest

modAPI

Option Compare Database
Option Explicit





Private Declare Function ShellExecute Lib "shell32.dll" Alias _
   "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
   As String, ByVal lpFile As String, ByVal lpParameters _
   As String, ByVal lpDirectory As String, ByVal nShowCmd _
   As Long) As Long
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long


Private Const BIF_RETURNONLYFSDIRS = &H1

Public Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetComputerName _
Lib "kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long

Public Function SaveAsCommonDialog(iOfficeVersion As OfficeProduct, _
    strForm As Form, _
    Optional sTitle = "Save File", _
    Optional sDefaultDir As String, _
    Optional filename As String = "") As String
    
Const clBufferLen As Long = 255
Dim OFName As OPENFILENAME, sBuffer As String * clBufferLen
Dim sFilter As String
On Error GoTo ExitFunction

OFName.lStructSize = Len(OFName)
OFName.hwndOwner = strForm.hwnd ' GetActiveWindow  'or Me.hwnd in VB
'OFName.hInstance = 0                'or App.hInstance in VB

'If Len(sFilter) Then
'    OFName.lpstrFilter = sFilter
'Else
'    OFName.lpstrFilter = "Text Files (*.txt)" & Chr$(0) & "*.txt" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0)
'End If
    
Select Case iOfficeVersion
    Case OfficeProduct.Excel2007Only
       
        sFilter = "Excel 2007 Workbooks (*.xlsx)" & Chr(0) & "*.xlsx" & Chr(0) & _
            "Excel 2003 Workbooks (*.xls)" & Chr(0) & "*.xls" & Chr(0)
        
    Case OfficeProduct.Access2007Only
        sFilter = "Access Databases 2007(*.acdb*)" & Chr(0) & "*.acdb" & Chr(0) & _
            "Access Databases 2003 (*.MDB)" & Chr(0) & "*.MDB & Chr(0)"
    
    Case Else
        sFilter = "All Files (*.*)" & Chr(0) & "*.*"
End Select
    
    
OFName.lpstrFilter = sFilter
OFName.nFilterIndex = 1
    
' set file to initialDir and Filename (Note - need to retain length of sBuffer)
If filename <> "" Then
    Dim initialFilePath As String
    If Right(sDefaultDir, 1) = "\" Then
        initialFilePath = sDefaultDir & filename
    Else
        initialFilePath = sDefaultDir & "\" & filename
    End If
    sBuffer = initialFilePath & (Right(sBuffer, Len(sBuffer) - Len(initialFilePath)))
End If

OFName.lpstrFile = sBuffer
OFName.nMaxFile = clBufferLen       'Set max number of characters
OFName.lpstrFileTitle = sBuffer
OFName.nMaxFileTitle = clBufferLen  'Set max number of characters
    
'Set the initial directory
If Len(sDefaultDir) Then
    OFName.lpstrInitialDir = sDefaultDir
Else
    OFName.lpstrInitialDir = CurDir$
End If

OFName.lpstrTitle = sTitle
OFName.Flags = 0

'debug.Print "sBuffer: " & sBuffer

'Show dialog
If GetSaveFileNameA(OFName) Then
    SaveAsCommonDialog = Left$(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) - 1)
Else
    SaveAsCommonDialog = ""
End If
ExitFunction:
    On Error GoTo 0
End Function


Function getWindowsUserId() As String
' Returns the network login name.
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = GetUserName(strUserName, lngLen)
If lngX <> 0 Then
    getWindowsUserId = Left$(strUserName, lngLen - 1)
Else
    getWindowsUserId = "Unknown"
End If

End Function


Public Function GetWorkstationId() As String
' Retrieve the name of the computer.
Const acbcMaxComputerName = 15
Dim strBuffer As String
Dim lngLen As Long
strBuffer = Space(acbcMaxComputerName + 1)
lngLen = Len(strBuffer)
If CBool(GetComputerName(strBuffer, lngLen)) Then
    GetWorkstationId = Left$(strBuffer, lngLen)
Else
    GetWorkstationId = ""
End If
End Function


Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function


Function APIGetOpenFileNameCD(iOfficeVersion As OfficeProduct, _
    strForm As Form, Optional _
    InitialFileName As String) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
    
    
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = strForm.hwnd
    
Select Case iOfficeVersion
    Case OfficeProduct.Excel2007Only
       
        sFilter = "Excel 2007 Workbooks (*.xlsx)" & Chr(0) & "*.xlsx" & Chr(0) & _
            "Excel 2003 Workbooks (*.xls)" & Chr(0) & "*.xls" & Chr(0)
        
    Case OfficeProduct.Access2007Only
        sFilter = "Access Databases 2007(*.acdb*)" & Chr(0) & "*.acdb" & Chr(0) & _
            "Access Databases 2003 (*.MDB)" & Chr(0) & "*.MDB & Chr(0)"
    
    Case Else
        sFilter = "All Files (*.*)" & Chr(0) & "*.*"
End Select
    'sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
      "JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
If Len(InitialFileName) > 0 Then
    OpenFile.lpstrInitialDir = InitialFileName
Else
    OpenFile.lpstrInitialDir = "C:\"
End If
    

OpenFile.lpstrTitle = "Select a file name"
OpenFile.Flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
    'MsgBox "A file was not selected!", vbInformation, _
      "Select a file using the Common Dialog DLL"
    Exit Function
Else
    APIGetOpenFileNameCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function


Public Function OpenPDFFile(ByVal strFileName) As Boolean
Dim lngErr As Long
'Dim objShell As Object

'objShell.ShellExecute
Const SW_SHOWNORMAL = 1
lngErr = ShellExecute(0, "OPEN", strFileName, vbNullString, vbNullString, SW_SHOWNORMAL)

OpenPDFFile = lngErr > 32
End Function
at 7:40 PM No comments:
Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest

modError


Option Compare Database
Option Explicit

Public Const glHANDLED_ERROR As Long = 9999
Public Const glUSER_CANCEL As Long = 18

Public gstrERROR_LOG_PATH As String
Public gbDEBUG_MODE As Boolean
Private Const msSILENT_ERROR As String = "UserCancel"
Private Const msFILE_ERROR_LOG As String = "Error.log"

Public Sub SetErrorFilePath(strPath As String)
'test if folder exists
If Len(strPath) = 0 Then Exit Sub
If Right$(strPath, 1) = "\" Then strPath = Left(strPath, Len(Trim(strPath)) - 1)
gstrERROR_LOG_PATH = strPath
End Sub

Public Function bCentralErrorHandler(ByVal sModule As String, _
    ByVal sProc As String, _
    Optional ByVal sSourceFileName As String, _
    Optional ByVal bEntryPoint As Boolean, _
    Optional ByVal strSeverityCode = "L") As Boolean
 'SeverityCode can be the following values
 'L:low -will use vbInformation icon
 'H: high/critical -will use vbCritical icon
Static sErrMsg As String
Dim iFile As Integer    'file handle
Dim lErrNum As Long
Dim sPath As String
Dim sLogText As String
Dim sFullSource As String
Dim strUserID As String

lErrNum = Err.Number
If lErrNum = glUSER_CANCEL Then sErrMsg = msSILENT_ERROR
If Len(sErrMsg) = 0 Then sErrMsg = Err.Description

'no error allowed here
On Error Resume Next
If Len(sSourceFileName) = 0 Then sSourceFileName = CurrentProject.Name

'get the app directory
If Len(gstrERROR_LOG_PATH) > 0 Then
    sPath = AddBS(gstrERROR_LOG_PATH)
Else
    sPath = AddBS(getAppPath())
End If

'construct the fully-qualified error source name
sFullSource = "[" & sSourceFileName & "]" & sModule & "." & sProc

'error to be logged
sLogText = "  " & sFullSource & ", Error " & CStr(lErrNum) & ":" & sErrMsg & _
    " - " & strSeverityCode


'write the error text to a log file
iFile = FreeFile()
Open sPath & msFILE_ERROR_LOG For Append As #iFile
strUserID = getWindowsUserId()
Print #iFile, Format$(Now(), "mm/dd/yy hh:mm:ss"); ","; strUserID; ","; CStr(lErrNum); ","; sLogText
If bEntryPoint Then Print #iFile,
Close #iFile

'suppress silent errors
If sErrMsg <> msSILENT_ERROR Then
    If bEntryPoint Or gbDEBUG_MODE Or UCase$(strSeverityCode) = "H" Then
        'Application.ScreenUpdating = False
        MsgBox sErrMsg, vbCritical, sModule & "." & sProc
        'clear the static error message variable once
        'we've reach the entry point so that we're ready to handle the next erro
        sErrMsg = vbNullString
    End If
    bCentralErrorHandler = gbDEBUG_MODE
Else
    If bEntryPoint Then sErrMsg = vbNullString
    bCentralErrorHandler = False
End If
End Function
at 7:40 PM No comments:
Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest

modGlobals

modGlobals


Option Compare Database
Option Explicit
#Const DEBUG_MODE = 1
#Const PROD_MODE = 0
#Const APP_MODE = DEBUG_MODE
Public Const msMODULE As String = "modGlobals"

Public Enum ACTION_MODE
    navigate = 0
    AddNew = 1
    Update
    Delete
    cancellation
End Enum

Public Enum MaintenanceTables
    TBL_TalentType = 1
    TBL_JobStatus
    TBL_Language
End Enum

Public Enum FeedHistoryDetail
    ID = 0
    COB_Date
    StartTime
    EndTime
    RecordCount
    ElapsedTime
    DateCreated
    UserCreated
    DateModified
    UserModified
    FeedStatus
End Enum


Public Enum DailyWorkDetail
    ID = 0
    ClientID
    ClientName
    DailyWorkStatus
    ApprovedDate
    Approver
    CollateralBalance
    EquityBalance
    DailyWorkCalculationID
    IMRequirement
End Enum

Public Enum SentDailyWork
    ID = 0
    BatchID
    BatchTime
    ClientID
    ClientName
    Status
    DailyWorkId
End Enum


Public Enum SecurityUserQueue
    ID = 0
    EmployeeName
    UserAccessLevel
    UserAccessLevelDescription
    TransactionType
    TransactionTypeDescription
    ApprovedDate
    Approver
    DateCreated
    UserCreated
    DateModified
    UserModified
End Enum
    
Public Enum DailyWorkStatus
    Pending = 1
    Approved
    HoldBack
    AwaitingApproval
End Enum


' what is this used for
Public Enum SentDailyWorkStatus
    Pending = 1
    Approved
    HoldBack
    AwaitingApproval    'new
    All
End Enum

Public Enum SentDailyWorkFilter
    Pending = 1
    Approved
    HoldBack
    AwaitingApproval    'new
    Sent
    All
End Enum

Public Enum UserRole
    ReadOnly = 1
    System = 2
    NewBusiness = 3
    MarginAnalyst = 4
    MarginAnalystsSupervisor = 5
    Admin = 8
    SuperAdmin = 10
End Enum

Public Enum SecurityObject
    FeedAutoImport = 1
    FeedManualImport
    ClientMaintain
    ClientApprover
    StatementHoldBack
    StatementApproval
    SecurityMaintain
    SecurityApprove
    StatementAwaitingApproval
    BulkSend
End Enum
    
Public Enum QBEReport
    QBEReportId = 0
    reportname
    Text
    AlphaCriteria
    DateCriteria
    TableName
    PrimarySort
    Group
End Enum
    
    
Public Enum MailClient
    OutLook = 1
    LotusNotes
End Enum

Public Enum TransactionType
    Add = 1
    Update
    Delete
End Enum

Public Enum TradeDetail
    [ID] = 0
    Row
    Underlying
    MaturityDate
    notational
    SettlementPrice
    PriorSettlementPrice
    AccruedCpn
    MTM
    ResetToPar
    InitialCoupon
    CPNSettlement
    [VMExcess_Defecit]
    [Todays Total VM Req]
    [TotalCashAdj]
End Enum

Public Enum CashMovementDetail
    [ID] = 0
    Amount
    DateCreated
    UserCreated
    DateModified
    UserModified
    TransactionType
End Enum

Public Enum DailyWorkCashMovementDetail
    ID = 0
    COB_Date
    Amount
    Approver
    ApprovedDate
    DateCreated
    UserCreated
    DateModified
    UserModified
    TransactionType
    ClientID
End Enum

Public Const ERR_MSG_REQUIRED_FIELD_MISSING As String = _
    "Required field.  Can't be blank or missing."
Public Const ERR_MSG_INVALID_START_DATE As String _
    = "Invalid Start Date or must be less than ending Date"
Public Const ERR_MSG_BLANK_NAME As String = "Required value -must supply a name"
Public Const ERR_MSG_NO_RIGHTS_TO_FUNCTION As String = "Not enough priveleges to run this command. " & _
    "Please contact system administrator for more assistance"

Public Const ERR_MSG_EXISTS_IN_QUEUE As String = "No need to try again because it is all ready in the queue of pending changes."
'=====================================================
Public Const APP_NAME As String = "ProductivityTool"
'Public APP_PATH As String
'Public APP_INPUT_PATH As String
'Public APP_OUTPUT_PATH As String


'Public Const APP_PATH As String = CurrentProject.Path
'Public Const APP_INPUT_PATH As String = AddBS(APP_PATH) & "Input"
'Public Const APP_OUTPUT_PATH As String = AddBS(APP_PATH) & "Output"

Public Const APP_LOCAL_APP_PATH  As String = "C:\My Documents\My App"
Public Const APP_LOCAL_INPUT_PATH As String = APP_LOCAL_APP_PATH & "\" & "Input"
Public Const APP_LOCAL_OUTPUT_PATH As String = APP_LOCAL_APP_PATH & "\" & "Output"


Public Const COMPANY_NAME As String = "Deutsche Bank AG"
'Public gbDEBUG_MODE As Boolean
Public gbApp_SetupOccurred As Boolean
Public Const MASK_DATE As String = "mm/dd/yyyy"
Public Const MASK_MONEY As String = "$#,##0.00;($#,##0.00)"
Public Const MASK_HOLDINGS As String = "#,##0;(#,##0)"
Public lngMyEmpID As Long
Public gstrUserName As String
'Public gUserAccessLevel As UserRole
Click here to Reply or Forward
0.97 GB (6%) of 15 GB used
Manage
Terms - Privacy
Last account activity: 0 minutes ago
Currently being used in 1 other location  Details
Bill DeCastro

Show details

at 7:38 PM No comments:
Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest

Friday, April 15, 2016

C# VBA Side by Side Time a long running process

Ever have a need to time a long running process?  Well in Excel VBA, its a 2 step process that includes making a declaration to a WinAPI function called GetTickCount() and then directly calling this function in code.  In C#, its a lot simpler because there is  a TickCount property in the Environment class.

The algorithm to time an application is to store the results of System time before starting a long process (start time) and then again store the system timer when the process is done (ending time).

Access VBA

 The elapsed time is the difference between the ending time and start time.  The high level view is to:

Step A: Declare the API call in a separate module. For more detail refer to this article

Step B: Calling the GetTickCount() API function as strategic points in the long running process

Step C: Calculate the elapsed time and update the user


DoCmd.Hourglass True
lngStartTime = GetTickCount()
Call SysCmd(acSysCmdInitMeter, "Downloading files ...", Me.lvHistory.ListItems.Count)
For Each objli In Me.lvHistory.ListItems
        Call CreateDailyWorkWB5(objli.SubItems(DailyWorkDetail.ClientID), _
             objli.SubItems(DailyWorkDetail.ClientName), _
             COB_Date, _
             intVersionNo, _
             intPriorVersionNo:=getPriorVersionNo())
               
         iCounter = iCounter + 1
         Call SysCmd(acSysCmdUpdateMeter, iCounter)
                
           
Next
lngEndTime = GetTickCount()

lngElapsedTime = (lngEndTime - lngStartTime) * 0.001
MsgBox "Just exported " & Format(iCounter, "##,##0") & " record(s) in " & _
     Format(lngElapsedTime, "##,##0") & " second(s) ", vbInformation, "Results"




C#






intStartTime = Environment.TickCount;
recordsAffected=objTask.RefreshCDLReferenceFile(strFileName,strFileNameAccess:strAccessDb);
intEndTime = Environment.TickCount;
decElapsedTime = (decimal)((intEndTime - intStartTime) * .001);
MessageBox.Show("Imported " + recordsAffected.ToString() + " row(s) in " + decElapsedTime.ToString() + " sec(s)", "Results", MessageBoxButtons.OK, MessageBoxIcon.Information);






See Also




More info about the Tickcount property












at

1:30 PM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
C# VBA,
WinAPI
















          

        

          

        

Sunday, June 28, 2015


          

        









Excel VBA Copy the contents of a recordset to a range










To copy the results of query, you first have to execute a query - using either ADO or DAO (for this example, ADO will be used). Then, you use the CopyRecordset method of the range object





Excel VBA


Dim objConn as ADODB.Connection


Dim objCmd as ADODB.Command






Set objConn = Application.CurrentProject.Connection
Set objCmd = New ADODB.Command
With objCmd
    Set .ActiveConnection = objConn
    .CommandType = adCmdStoredProc
    .CommandText = "qryBrazilianRevenueExtract"
    Set rs = .Execute
End With


Set objRange=Worksheets(1).Cells(2,1).CurrentRegion
objRange.Cells(1, 1).CopyFromRecordset rs














at

5:56 PM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
Excel VBA,
Excel.Range
















          

        

          

        

Wednesday, June 17, 2015


          

        









C# VBA Side by Side using Enumerations










An enumeration is a set of named constants whose values are generally related.  In Excel VBA, an enumeration statement (Enum) is made in the Declarations section of a standard or public class module. In C#, an enumeration is defined directly within a namespace.  By default, the first enumerator is assigned the value of 0 and the value of each successive enumerator is increased by 1.







Excel VBA



Tip: IF the enum description, contains blanks or special characters, then surround the enum name with brackets ([ ]).










Public Enum OfficeProduct
    Access2007Only = 1
    [MSAccess95-2003]
    Excel2007Only
    [MSExcel95-2003]
    [XML]
End Enum






C#






public enum OfficeProduct {
       Access2007Only=1,
       MSAccess95_2003=2,
       Excel2007Only=3,
       MSExcel95_2003=4,
       XML=5};













at

11:43 AM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
C# VBA
















          

        

          

        

Friday, April 24, 2015


          

        









C# Excel VBA Side by Side Putting a value in a cell










To enter a value in cell, use the value property of range object.  A range object can consist of a cell or range of cells.  One example is the following





C#



Prior to running this code, you will need to  follow these steps in 










using Excel=Microsoft.Office.Interop.Excel;
    class Program
    {
        static void Main(string[] args)
        {
            Excel.Application objExcel=new Excel.Application();
            //Excel.Worksheet objWks;
            try
            {  
                objExcel.Visible=true;
                var objWb = objExcel.Workbooks.Add();

                Excel.Worksheet objWks = objWb.Worksheets[1] as Excel.Worksheet;
                
                objWks.Cells[1, 1].value = 1;
            }
            catch(Exception ex)
            {
                Console.WriteLine(ex.Message);
            }
            finally
            {
                if (objExcel !=null)
                {
                    objExcel=null;
                }
            }
        }
    }













at

12:48 PM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
Excel PIA,
Excel.Range
















          

        

          

        

Sunday, April 5, 2015


          

        









C# Excel VBA Side by Side Open a workbook










The Workbook object has an Open method that opens a workbook. The following samples show how to both open a workbook in edit mode and read-only mode in both Excel VBA and C#.





Excel VBA

Readonly:




Dim strFileName as string
Workbooks.Open(FileName:=strExcelFile, ReadOnly:=True)








Normal mode:




Dim strFileName as string
Workbooks.Open(FileName:=strExcelFile)






C#



Readonly:






Excel.Workbook objWb;
objWb = objExcelApp.Workbooks.Open(Filename: fileName,ReadOnly:true);





Normal mode:










Excel.Workbook objWb;
objWb = objExcelApp.Workbooks.Open(Filename: fileName);























at

6:29 PM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
C# VBA,
workbook
















          

        

          

        

Saturday, March 14, 2015


          

        


























at

1:37 PM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest























          

        

          

        

Wednesday, February 25, 2015


          

        









Excel VBA  Removing the top row from a range










Every need a quick way to excise the header row from a range. Well this snippet will work with any range that has header.  The trick is to use the OFFSET() method of the range object.






Dim wksTemplate As Worksheet
Dim objRange As Range
Dim lngRowCount As Long

Set wksTemplate = ActiveWorkbook.Worksheets("Data")

Set objRange = wksTemplate.Cells(1, 1).CurrentRegion

        
lngRowCount = objRange.Rows.Count
Debug.Print "Before resizing " & lngRowCount
Set objRange = objRange.Offset(1, 0).Resize(objRange.Rows.Count - 1, objRange.Columns.Count)
lngRowCount = objRange.Rows.Count
Debug.Print "After resizing " & lngRowCount














at

3:16 AM



No comments:
  










Email ThisBlogThis!Share to XShare to FacebookShare to Pinterest







Labels:
Excel Range,
Excel VBA
















        

      





Newer Posts


Older Posts

Home








Subscribe to:
Posts (Atom)































Web Designer




  • New York Web Design









Tags




    

  • 
A1
(1)

    • 

  • 
ADO
(3)

    • 

  • 
ADO.NET
(2)

    • 

  • 
After. SQL Server
(1)

    • 

  • 
Application setup
(1)

    • 

  • 
C# Excel PIA
(2)

    • 

  • 
C# VBA
(7)

    • 

  • 
cell
(1)

    • 

  • 
Cells
(2)

    • 

  • 
column
(1)

    • 

  • 
Command
(1)

    • 

  • 
Data Access
(1)

    • 

  • 
DML
(1)

    • 

  • 
ETL
(1)

    • 

  • 
Excel PIA
(1)

    • 

  • 
Excel Range
(3)

    • 

  • 
Excel VBA
(6)

    • 

  • 
Excel. Application
(1)

    • 

  • 
Excel.Range
(7)

    • 

  • 
formula
(4)

    • 

  • 
Instead Of
(1)

    • 

  • 
macro
(3)

    • 

  • 
MS Access
(2)

    • 

  • 
Name. ReferstoRange
(1)

    • 

  • 
Names
(1)

    • 

  • 
object
(1)

    • 

  • 
Properties
(1)

    • 

  • 
R1C1
(4)

    • 

  • 
Resize
(1)

    • 

  • 
row
(1)

    • 

  • 
stored procedure
(1)

    • 

  • 
Trigger
(1)

    • 

  • 
UDF
(4)

    • 

  • 
variable
(1)

    • 

  • 
WinAPI
(4)

    • 

  • 
workbook
(2)

    • 

  • 
worksheet
(1)

    • 











Search This Blog


































Archive








    

  • 



        ▼ 
      



2016

(38)

      

    • 



        ▼ 
      



December

(1)

        

      • Fee Letter Save Data in Child Form
        • 

      

      • 

    

      

    • 



        ► 
      



November

(13)

      • 

    

      

    • 



        ► 
      



October

(6)

      • 

    

      

    • 



        ► 
      



September

(17)

      • 

    

      

    • 



        ► 
      



April

(1)

      • 

    

    • 



    

  • 



        ► 
      



2015

(17)

      

    • 



        ► 
      



June

(2)

      • 

    

      

    • 



        ► 
      



April

(2)

      • 

    

      

    • 



        ► 
      



March

(1)

      • 

    

      

    • 



        ► 
      



February

(2)

      • 

    

      

    • 



        ► 
      



January

(10)

      • 

    

    • 



    

  • 



        ► 
      



2013

(10)

      

    • 



        ► 
      



October

(4)

      • 

    

      

    • 



        ► 
      



September

(5)

      • 

    

      

    • 



        ► 
      



August

(1)

      • 

    

    • 























































































Dado Enterprises. Simple theme. Powered by Blogger.