Results 1 to 5 of 5
  1. #1
    Join Date
    Jul 2005
    Posts
    144

    Red face Unanswered: Code does not work after long weekends

    I have below the code which works fine only during weekdays and after week end if I go on Monday it works.

    The code does not work after long week end if I come on Monday or Tuesday , the code does not work and does not give the results.

    This is vba code and it picks up the result from Mainframe

    A listing of all corps and their out of balance amounts (greater than zero).
    'Run from bundle or main session.
    'These codings are set to run from Bundle(commented out).

    ' Global variable declarations
    Global g_HostSettleTime%
    Global g_szPassword$

    Declare Sub Mill1 (strYesterdayDate)
    Declare Sub PROGRAMEND
    Declare Sub StringFound
    Declare Sub StringNOTFound
    Declare Sub RoutineFind
    Declare Sub NoMatches(MillNum)
    Declare Sub PrintHeading(strExtraDate, strExtraTime)
    Declare Sub CheckForMillNum(strMillData)

    Dim Sess0 As Object
    Dim BundleEnd
    Dim strIsFinalDay
    Dim FName$
    Dim strExtraDate, strExtraTime
    Dim strMonthStamp, strYearEndDate
    Dim strMillName, strMillData

    Sub Main()
    '--------------------------------------------------------------------------------
    ' Get the main system object
    Dim Sessions As Object
    Dim System As Object
    Set System = CreateObject("EXTRA.System") ' Gets the system object
    If (System is Nothing) Then
    Msgbox "Could not create the EXTRA System object. Stopping macro playback."
    STOP
    End If
    Set Sessions = System.Sessions

    If (Sessions is Nothing) Then
    Msgbox "Could not create the Sessions collection object. Stopping macro playback."
    STOP
    End If
    '--------------------------------------------------------------------------------
    ' Set the default wait timeout value
    g_HostSettleTime = 900 '1000 milliseconds

    OldSystemTimeout& = System.TimeoutValue
    If (g_HostSettleTime > OldSystemTimeout) Then
    System.TimeoutValue = g_HostSettleTime
    End If

    ' Get the necessary Session Object
    Set Sess0 = System.ActiveSession
    If (Sess0 is Nothing) Then
    Msgbox "Could not create the Session object. Stopping macro playback."
    STOP
    End If
    If Not Sess0.Visible Then Sess0.Visible = TRUE
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)

    Dim MyScreen as object, MyArea as object
    Dim strExtraDate, strExtraTime

    Close #1

    'Get a random letter from the alphabet.
    Dim x as Integer
    Dim y
    Dim str1 as String
    Dim str2 as String
    Dim letter as String
    Dim randomvalue
    Dim upper, lower
    Dim msgtext
    upper=Asc("z")
    lower=Asc("a")
    newline=Chr(10)
    For x=1 to 26
    Randomize
    randomvalue=Int(((upper - (lower+1)) * Rnd) +lower)
    letter=Chr(randomvalue)
    str1= letter
    For y = 1 to 15
    Next y
    Next x
    msgtext=str1

    'Check to make sure user is in Bundle.

    'strMenuHeading = Sess0.Screen.GetString(1,52,29)
    strMenuHeading = Sess0.Screen.GetString(1,02,80)
    intHeadingPosition =Instr(strMenuHeading,"C")
    If intHeadingPosition = 0 then
    Msgbox "PLEASE LOG INTO THE BUNDLE ENVIRONMENT AND RERUN.",48, "Error: DCBFCheck."
    Exit sub
    Else
    strMenuHeading = mid(strMenuHeading,intHeadingPosition,29)
    End if

    MyTimer = format(now, "hhmm")

    If strMenuHeading ="Current Report Selection List" Then
    strNow = Format(now, "mmdd")
    FNum% = 1

    FName$ = "S:\0AGS4\85671\GLM-FAR\PCLINK\script workfile\DCBFcheck" & strNow & msgtext & ".txt"

    Open FName$ for Output as FNum%

    ' This section of code contains the recorded events
    Sess0.Screen.SendKeys("<HOME>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.SendKeys("<TAB>")
    Sess0.Screen.SendKeys("<HOME>")
    Sess0.Screen.SendKeys("<TAB>")

    Dim InputDate$, InputPriorToDate$
    Dim strCorp, strDateAmount, Errormsg
    Dim strDcbfrec, strYesError, strNoError, strRecycleStatus
    Dim strYesterdayDate, strDayStamp

    'Get the current date and time of execution.
    strExtraDate = "Date.........: " & format(Now, "mm/dd/yy")
    strExtraTime = "Time.........: " & format(Time, "hh:mm:ss")

    'Get monthend date if monthend is been processed else get the current month

    strDayStamp=format(cvar(date), "mm/dddd/yy")
    strDayStamp = mid(strDayStamp,4,3) 'Sun, Mon, Tue, Wed, Thu, Fri, Sat.
    strFullDate = mid(Format(now,"m/dd/yy"), 1,8) '
    strIsFinalDay = Day(strFullDate)

    stryear= Year(strFullDate)
    stryear = mid(stryear,3,2) '02
    strmonth = Month(strFullDate) '0,1,2,3..
    strCheckforZeroMonth =Val((Month(strFullDate)) -1)
    strMEStartDay = strmonth & "/01" & stryear
    strMEFinalDay = strmonth & "/14" & stryear
    If strCheckforzeromonth = 0 then 'December
    strmonthserial = 12 & "/0" & val(stryear -1)
    Else
    strmonthserial = Val((Month(strFullDate)) -1) & "/" & stryear 'Month(strFullDate) '02 - Jan
    End if
    'msgbox strIsFinalDay


    IF strIsFinalDay = 10 or strIsFinalDay = 11 or strIsFinalDay = 12 or strIsFinalDay = 13 or strIsFinalDay = 14 THEN
    strCheckFinal = Ucase$(InputBox("If FINAL; Enter: Y If NOT FINAL; Enter: N"))

    '***MONTH END IS NOT FINAL****
    '09/14/05 09/01/05 09/14/05 09/14/05
    If strFullDate >= strMEStartDay and strFullDate <= strMEFinalDay AND strCheckFinal = "N" Then
    LastMonthName = Ucase$(format(strmonthserial, "mmm")) 'AUG
    strMonthName = format(strmonthserial, "mmmm") 'August
    strMonthStamp = "M/E " & strMonthName
    strYearEndDate = format(cvar(date), "yyyy")
    PrintHeading strExtraDate, strExtraTime
    Else
    '***MONTH END IS FINAL
    IF strCheckFinal = "Y" Then
    strMonthName = Val(strFullDate) & "/" & mid(strFullDate,7,2)' 9/5
    strMonthStamp = format(strMonthName, "mmmm") 'This month: September
    LastMonthName = UCase$(mid(strMonthStamp,1,4)) 'SEPT
    strYearEndDate = format(cvar(date), "yyyy") '2005
    PrintHeading strExtraDate, strExtraTime
    End If
    End IF

    '***DAY 1 TO DAY 9****
    ELSEIF strIsFinalDay <= 9 THEN
    LastMonthName = Ucase$(format(strmonthserial, "mmm")) 'AUG
    strMonthName = format(strmonthserial, "mmmm") 'August
    strMonthStamp = "M/E " & strMonthName
    strYearEndDate = format(cvar(date), "yyyy")
    PrintHeading strExtraDate, strExtraTime

    '***DAY 15 AND GREATER****
    ELSEIF strIsFinalDay >=15 Then
    strMonthName = Val(strFullDate) & "/" & mid(strFullDate,7,2)' 9/5
    strMonthStamp = format(strMonthName, "mmmm") 'This month: September
    LastMonthName = UCase$(mid(strMonthStamp,1,4)) 'SEPT
    strYearEndDate = format(cvar(date), "yyyy") '2005
    PrintHeading strExtraDate, strExtraTime
    END IF

  2. #2
    Join Date
    Jul 2005
    Posts
    144

    Red face forgot to attach few more lines

    few more lines


    'If today is Monday,then check Fridays data else check yesterday's data.
    If strDayStamp="Mon" Then
    strYesterdayDate=format(CVar(Date)-3, "mm/dd/yy") 'For weekend (Friday)
    Else
    strYesterdayDate=format(CVar(Date)-1, "mm/dd/yy") 'Date for previous day.
    End If
    PAUSE 1

    ' strYesterdayDate = "09/01/06"
    Mill1 strYesterdayDate
    Else
    Msgbox "PLEASE LOG INTO THE BUNDLE ENVIRONMENT AND RERUN.",48, "Error: DailyCheck."
    Exit Sub
    End If
    End Sub


    Sub PrintHeading(strExtraDate, strExtraTime)
    Print #1, " "
    Print #1, " "
    Print #1, " DCBF (" & strMonthStamp & " " & strYearEndDate &") DAILY CUMULATIVE BALANCE RECONCILIATION REPORT"
    Print #1, " "
    Print #1, strExtraDate
    Print #1, strExtraTime
    Print #1, " "
    Print #1, "MILL ERROR MESSAGE RECYCLE STATUS "
    Print #1, "NUM. YES/NO "
    Print #1,"--------------------------------------------------------------------------------------------------"
    End Sub



    Sub Mill1 (strYesterdayDate)
    Sess0.Screen.Sendkeys("<Tab>")
    Sess0.Screen.PutString strYesterdayDate,6,50
    Sess0.Screen.Sendkeys("<Tab>GL:M<Tab> ")

    strDCBFrec = " DCBF RECONCILIATION "
    strDCBFrecCZ = " DCBF RECONC CZ"
    strDCBFrecCU = " DCBF RECONC CU"
    strMill = "MILL"
    'msgbox i
    For i = 1 to 18 step 1
    if i = 1 Then
    strMillData = "M1" & strDCBFrec
    ELSEIF i = 2 Then
    strMillData = "M2" & strDCBFrec
    ELSEIF i = 3 Then
    strMillData = "M3" & strDCBFrec
    ELSEIF i = 4 Then
    strMillData = "M4" & strDCBFrec
    ELSEIF i = 5 Then
    strMillData = "M5" & strDCBFrec
    ELSEIF i = 6 Then
    strMillData = "M6" & strDCBFrec
    ELSEIF i = 7 Then
    strMillData = "M7" & strDCBFrec
    ELSEIF i = 8 Then
    strMillData = "M8" & strDCBFrec
    ELSEIF i = 9 Then
    strMillData = "M9" & strDCBFrec
    ELSEIF i = 10 Then
    strMillData = "MA" & strDCBFrec
    ELSEIF i = 11 Then
    strMillData = "MB" & strDCBFrec
    ELSEIF i = 12 Then
    strMillData = "MC" & strDCBFrec
    ELSEIF i = 13 Then
    strMillData = "MD" & strDCBFrec
    ELSEIF i = 14 Then
    strMillData = "ME" & strDCBFrec
    ELSEIF i = 15 Then
    strMillData = "M2" & strDCBFrecCZ
    PRINT #1, ""
    PRINT #1, ""
    PRINT #1, "",,
    PRINT #1, " 'M2 DCBF RECONC CZ' for Other Actual"
    PRINT #1, " ----------------------------------"
    ELSEIF i = 16 Then
    strMillData = "MC" & strDCBFrecCU
    PRINT #1, ""
    PRINT #1, "",,
    PRINT #1, " 'MC DCBF RECONC CU' for US dollars"
    PRINT #1, " ----------------------------------"
    ELSEIF i = 17 Then
    strMillData = "MD" & strDCBFrecCZ
    PRINT #1, ""
    PRINT #1, "",,
    PRINT #1, " 'MD DCBF RECONC CZ' for Other Actual"
    PRINT #1, " ----------------------------------"
    ELSEIF i = 18 Then
    strMillData = "ME" & strDCBFrecCZ
    PRINT #1, ""
    PRINT #1, "",,
    PRINT #1, " 'ME DCBF RECONC CZ' for Other Actual"
    PRINT #1, " ----------------------------------"
    END IF

    strMillName = i
    Select Case strMillName
    CASE 10
    strMillName ="A"
    CASE 11
    strMillName ="B"
    CASE 12
    strMillName ="C"
    CASE 13
    strMillName ="D"
    CASE 14
    strMillName ="E"
    CASE 15
    strMillName ="2"
    CASE 16
    strMillName ="C"
    CASE 17
    strMillName ="D"
    CASE 18
    strMillName ="E"
    Case Else
    END Select


    Sess0.Screen.PutString strMillData
    Sess0.Screen.Sendkeys("<Enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime) '2
    Errormsg = Sess0.Screen.GetString(1,88,16) 'Get first error msg at top of screen.
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)'/2 '1
    IF Errormsg = "No matches found" Then
    NoMatches(strMillName)
    GOTO NEXTCORP
    ELSE

    CheckForMillNum strMillData
    Print #1, "Mill " & strMillName & ":",
    RoutineFind
    Sess0.Screen.Sendkeys("<Pf3>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab>")
    Sess0.Screen.SendKeys("<EraseEOF>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    END IF
    NEXTCORP: NEXT i
    PROGRAMEND
    End Sub




    Sub CheckForMillNum(strMillData)
    MillInfo = strMillData 'M1 DCBF RECONCILIATION
    Select Case MillInfo
    Case "M1 DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "M2 DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab>S<enter >")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "M9 DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab>S<enter >")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "MB DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "MC DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab>S< enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "MC DCBF RECONC CU"
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab>S< enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "MD DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab><Tab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "MD DCBF RECONC CZ"
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab><Tab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "ME DCBF RECONCILIATION "
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case "ME DCBF RECONC CZ"
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab><Tab><Tab><T ab>S<enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    Case Else
    Sess0.Screen.Sendkeys("<BackTab><BackTab>S<enter>" )
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    End Select
    End Sub



    Sub RoutineFind
    Do
    Sess0.Screen.Sendkeys("F ERROR<Enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    strYesError = Sess0.Screen.GetString(1,88,6)
    If strYesError = "Found " Then
    StringFound
    ElseIf strYesError = "End of" then
    StringNOTFound
    Exit Do
    END IF
    Exit Do
    Loop
    End Sub



    Sub NoMatches(MillNum)
    PAUSE 1
    MillNum = Sess0.Screen.GetString(6,73,1)
    PAUSE 1
    Print #1, "Mill " & MillNum & ":",
    Print #1, "No match found", '/A",
    Print #1, strYesterdayDate
    Print #1, ""',
    Sess0.Screen.Sendkeys("<Tab><Tab><Tab>")
    End Sub


    Sub StringFound
    Print #1, "YES ERROR" & " " ,
    Sess0.Screen.Sendkeys("BOT<Enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    strRecycleStatus = Sess0.Screen.GetString(13,20,56)
    Print #1, strRecycleStatus
    Print #1, ""
    End Sub


    Sub StringNOTFound
    Print #1, "NO ERROR" & " " ,
    Sess0.Screen.Sendkeys("BOT<Enter>")
    Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
    strRecycleStatus = Sess0.Screen.GetString(13,20,56)
    Print #1, strRecycleStatus
    Print #1, ""
    End Sub



    Sub PROGRAMEND

    Msgbox "File Location: (" & FName$ & ") ", 64, "Program Execution Finished: Mill (1-C check) Daily Check."
    Exit Sub
    End Sub

  3. #3
    Join Date
    May 2005
    Posts
    1,191
    Um... Perhaps you could narrow it down as to what part of the code is giving trouble?
    Me.Geek = True

  4. #4
    Join Date
    Mar 2006
    Posts
    163
    What's the connection with Access?

  5. #5
    Join Date
    Jan 2007
    Location
    California, USA
    Posts
    520
    Right at the start of your code you are checking back to Friday if today is Monday. But Friday is not always a work day, so you need to change that part of the routine to look for the last work day, rather than thinking Monday always looks back to Friday. And Tuesday does not always look back to Monday, sometimes it will look back to Friday, and maybe even Thursday. What you need is a calendar type of table in which you can list either all the workdays, or all the days off. Then rather than looking at what is today, therefore the last work day was Friday if today is Monday, etc. You can look to your calendar table to find today's date there, then go back one record and that will be your last day worked before today.

    Another method would be to check for the last date in a table that gets daily input when your company works. Then you can know that the Max date that is Less than today's date will be your last day worked.

    Hope this helps,

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •