Here is the entire page of code - I didn't show all of it because I honestly did not think all of it was relevant to my issue.
Option Compare Database
Dim OIA As New AutOIA
Dim PS As New AutPS
Dim SessionName As Variant
Dim NbCaract As Integer
Dim i As Integer
Dim aCells As Variant
Dim aDumpCells As Variant
Dim iLastRow As Long
Dim aRecord(6) As Variant
'Option Explicit
Sub login()
cleanDBall
Dim MySession As New AutSess
SessionName = "A"
MySession.SetConnectionByName (SessionName)
Set OIA = MySession.autECLOIA
Set PS = MySession.autECLPS
OIA.WaitForAppAvailable
OIA.WaitForInputReady
Call sendToNa("PUT", "cms091", 18, 70, 0, 0) 'change UNSERNAME here
Call sendToNa("PUT", "clubmed5", 19, 70, 0, 0) 'change PASSWORD here qwerty
Call sendToNa("COM", "enter", 0, 0, 0, 0)
Call sendToNa("COM", "enter", 0, 0, 0, 0)
Call sendToNa("PUT", "s", 7, 2, 0, 0)
Call sendToNa("COM", "enter", 0, 0, 0, 0)
End Sub
Sub collect_Info_like_winter()
Dim MySession As New AutSess
Dim SessionName As String
'Récupération du nom de la session
SessionName = "A"
'Connection à la session de la NA
MySession.SetConnectionByName (SessionName)
Set OIA = MySession.autECLOIA
Set PS = MySession.autECLPS
OIA.WaitForAppAvailable
OIA.WaitForInputReady
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
Dim rst2 As ADODB.Recordset
Set rst2 = New ADODB.Recordset
rst.Open "select Village,Category,NA_SD,NS_LD, screens, Occ from CMDS ", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic
'MsgBox rst.RecordCount
With rst
Do Until .EOF
'For iOcc = 1 To .Fields("Occ")
Call sendToNa_like_winter("PUT", "0nb", 22, 21, 0, 0)
Call sendToNa_like_winter("COM", "enter", 0, 0, 0, 0)
Call sendToNa_like_winter("PUT", .Fields("NA_SD"), 4, 19, 0, 0) 'Pass NA_SD
Call sendToNa_like_winter("PUT", .Fields("NS_LD"), 4, 46, 0, 0) 'Pass NS_LD
Call sendToNa_like_winter("PUT", .Fields("Village"), 5, 19, 0, 0) 'Pass Village
Call sendToNa_like_winter("PUT", .Fields("Category"), 5, 54, 0, 0) 'Pass Category
'Call sendToNa_like_winter("PUT", iOcc, 6, 37, 0, 0) 'Pass Occ
Call sendToNa_like_winter("COM", "enter", 0, 0, 0, 0)
'check for following
Call sendToNa_like_winter("GET4", "", 24, 2, iLastRow, 1)
' If aRecord(11) = "9073" Then
' GoTo SkipRecord
If aRecord(1) = "9073" Or aRecord(1) = "9044" Then
GoTo SkipRecord
End If
For j = 1 To .Fields("Screens") + 1
i = 0
For i = 0 To 10
iLastRow = iLastRow + 1
Call sendToNa_like_winter("GET9", "", 10 + i, 3, iLastRow, 0)
Call sendToNa_like_winter("GET4", "", 5, 19, iLastRow, 1)
Call sendToNa_like_winter("GET17", "", 5, 26, iLastRow, 2)
Call sendToNa_like_winter("GET6", "", 5, 54, iLastRow, 3)
Call sendToNa_like_winter("GET4", "", 10 + i, 13, iLastRow, 4)
Call sendToNa_like_winter("GET4", "", 10 + i, 25, iLastRow, 5)
Call sendToNa_like_winter("GET4", "", 10 + i, 19, iLastRow, 6)
Call sendToNa_like_winter("GET1", "", 1, 7, iLastRow, 7)
sDBcmd = "insert into availability values("
For irec = 0 To 7
sDBcmd = sDBcmd + "'" + VBA.Trim(aRecord(irec)) + "'" + ","
Debug.Print (irec)
Debug.Print (aRecord(irec))
Next irec
sDBcmd = sDBcmd + "'" + VBA.Date$ + "')"
'Debug.Print sDBcmd
cmd1.CommandText = sDBcmd
cmd1.Execute
Next i
Call sendToNa("COM", "PF8", 0, 0, 0, 0)
Next j
SkipRecord:
aRecord(iCol) = "9999"
'Next iOcc
.MoveNext
Loop
.Close
End With
Call cleanDB
End Sub
Sub sendToNa_like_winter(sAction As Variant, SCMD As Variant, iNArow As Integer, _
iNAcol As Integer, iRow As Long, iCol As Integer)
Select Case UCase(sAction)
'pour inscrire la donnée dans la NA
Case "PUT"
If SCMD <> "" Then
PS.SendKeys SCMD, iNArow, iNAcol
OIA.WaitForInputReady
End If
'Pour lancer une commande NA, par exemple ENTER ou PF2
Case "COM"
If SCMD <> "" Then
PS.SendKeys ("[" & UCase(CStr(SCMD)) & "]")
OIA.WaitForInputReady
PS.WaitForAttrib 1, 2, "00", "3c", 3, 2000
PS.WaitForCursor 1, 3, 2000
End If
'Mettre une zone à blanc
Case "BLANK"
If SCMD <> "" Then
PS.SendKeys String(SCMD, " "), iNArow, iNAcol
OIA.WaitForInputReady
End If
'Pour récupérer une donnée sur la NA dans le fichier Excel
Case Else
NbCaract = CInt(Mid$(sAction, 4, 2))
aRecord(iCol) = PS.GetText(iNArow, iNAcol, NbCaract)
' aDumpCells(iRow, iCol) = PS.GetText(iNArow, iNAcol, NbCaract)
End Select
End Sub
Sub logoff()
On Error Resume Next
Dim MySession As New AutSess
SessionName = "A"
MySession.SetConnectionByName (SessionName)
Set OIA = MySession.autECLOIA
Set PS = MySession.autECLPS
OIA.WaitForAppAvailable
OIA.WaitForInputReady
Call sendToNa("COM", "PF22", 0, 0, 0, 0)
Call sendToNa("PUT", "t", 7, 2, 0, 0)
Call sendToNa("COM", "enter", 0, 0, 0, 0)
Call sendToNa("COM", "PF3", 0, 0, 0, 0)
Call sendToNa("COM", "enter", 0, 0, 0, 0)
Set oShell = CreateObject("WSCript.shell")
'x = oShell.Run("c:\temp\cm")
'MsgBox x
oShell.AppActivate "Session A"
oShell.SendKeys "%{F4}"
On Error GoTo 0
End Sub
Sub collectInfo()
Dim MySession As New AutSess
'Récupération du nom de la session
SessionName = "A"
'Connection à la session de la NA
MySession.SetConnectionByName (SessionName)
Set OIA = MySession.autECLOIA
Set PS = MySession.autECLPS
OIA.WaitForAppAvailable
OIA.WaitForInputReady
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Dim iOcc
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
Dim rst2 As ADODB.Recordset
Set rst2 = New ADODB.Recordset
'rst.Open "select Village,Category,NA_SD,NS_LD, screens, Occ from occ_commands_unqS05p2 ", CurrentProject.Connection, _
' adOpenStatic, adLockOptimistic
rst.Open "select Village,Category,NA_SD,NS_LD, screens, Occ from CMDS ", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic
'MsgBox rst.RecordCount
With rst
Do Until .EOF
'For iOcc = 1 To .Fields("Occ")
Call sendToNa("PUT", "0nb", 22, 21, 0, 0)
Call sendToNa("COM", "enter", 0, 0, 0, 0)
Call sendToNa("PUT", .Fields("NA_SD"), 4, 19, 0, 0) 'Pass NA_SD
Call sendToNa("PUT", .Fields("NS_LD"), 4, 46, 0, 0) 'Pass NS_LD
Call sendToNa("PUT", .Fields("Village"), 5, 19, 0, 0) 'Pass Village
Call sendToNa("PUT", .Fields("Category"), 5, 54, 0, 0) 'Pass Category
'Call sendToNa("PUT", iOcc, 6, 37, 0, 0) 'Pass Occ
Call sendToNa("COM", "enter", 0, 0, 0, 0)
'check for following
Call sendToNa("GET4", "", 24, 2, iLastRow, 11)
' If aRecord(11) = "9073" Then
' GoTo SkipRecord
If aRecord(11) = "9073" Or aRecord(11) = "9044" Then
GoTo SkipRecord
End If
For j = 1 To .Fields("Screens") + 1
i = 0
For i = 0 To 10
iLastRow = iLastRow + 1
Call sendToNa("GET9", "", 10 + i, 3, iLastRow, 0)
Call sendToNa("GET4", "", 5, 19, iLastRow, 1)
Call sendToNa("GET17", "", 5, 26, iLastRow, 2)
Call sendToNa("GET6", "", 5, 54, iLastRow, 3)
Call sendToNa("GET4", "", 10 + i, 13, iLastRow, 4)
Call sendToNa("GET4", "", 10 + i, 25, iLastRow, 5)
Call sendToNa("GET4", "", 10 + i, 19, iLastRow, 6)
Call sendToNa("GET1", "", 1, 7, iLastRow, 7)
sDBcmd = "insert into availability values("
For irec = 0 To 7
sDBcmd = sDBcmd + "'" + VBA.Trim(aRecord(irec)) + "'" + ","
Next irec
sDBcmd = sDBcmd + "'" + VBA.Date$ + "')"
ReggieStrLength = Len(sDBcmd)
Debug.Print ReggieStrLength
ReggieRight = Right(sDBcmd, 40)
Debug.Print ReggieRight
Debug.Print sDBcmd
cmd1.CommandText = sDBcmd
cmd1.Execute
Next i
Call sendToNa("COM", "PF8", 0, 0, 0, 0)
Next j
' Next iOcc
'.MoveNext
'Loop
'.Close
'End With
SkipRecord:
aRecord(iCol) = "9999"
'Next iOcc
.MoveNext
Loop
.Close
End With
Call cleanDB
End Sub
'Option Explicit
Sub sendToNa(sAction As Variant, SCMD As Variant, iNArow As Integer, _
iNAcol As Integer, iRow As Long, iCol As Integer)
Select Case UCase(sAction)
'pour inscrire la donnée dans la NA
Case "PUT"
If SCMD <> "" Then
PS.SendKeys SCMD, iNArow, iNAcol
OIA.WaitForInputReady
End If
'Pour lancer une commande NA, par exemple ENTER ou PF2
Case "COM"
If SCMD <> "" Then
PS.SendKeys ("[" & UCase(CStr(SCMD)) & "]")
OIA.WaitForInputReady
PS.WaitForAttrib 1, 2, "00", "3c", 3, 2000
PS.WaitForCursor 1, 3, 2000
End If
'Mettre une zone à blanc
Case "BLANK"
If SCMD <> "" Then
PS.SendKeys String(SCMD, " "), iNArow, iNAcol
OIA.WaitForInputReady
End If
'Pour récupérer une donnée sur la NA dans le fichier Excel
Case Else
NbCaract = CInt(Mid$(sAction, 4, 2))
aRecord(iCol) = PS.GetText(iNArow, iNAcol, NbCaract)
End Select
End Sub
Sub cleanDB()
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
sClean = "DELETE * FROM tblAvailClean"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM tblAvailCleanHist"
cmd1.CommandText = sClean
cmd1.Execute
sFill = "insert into tblAvailClean " & _
"select * from qAvailability"
cmd1.CommandText = sFill
cmd1.Execute
sFill = "insert into tblAvailCleanHist " & _
"select * from qAvailabilityHist"
cmd1.CommandText = sFill
cmd1.Execute
sIndex = "DROP INDEX idxReadDate ON tblAvailClean" _
cmd1.CommandText = sIndex
cmd1.Execute
sIndex = "CREATE INDEX idxReadDate" & _
" ON tblAvailClean (dReadDate DESC, dDeparture ASC, occ,village_code,category)"
cmd1.CommandText = sIndex
cmd1.Execute
sClean = "delete from availability where readdate < (select max(readdate) from availability)"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "delete from tblAvailCleanHist where readdate < (select max(readdate) from tblAvailCleanHist)"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "delete from tblAvailCleanHist where readdate < (select max(readdate) from tblAvailClean)"
cmd1.CommandText = sClean
cmd1.Execute
End Sub
Sub DETERMINE_MOVEMENT()
' Sunday = 1, Monday = 2, Tuesday = 3 etc.
If Date Mod 7 = 3 Then
Call MOVEMENT_TUES
Else
Call MOVEMENT_WED_MON
End If
End Sub
Sub MOVEMENT_WED_MON()
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
sClean = "DELETE * FROM cln_test"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM MOVEMENT"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM comp_day"
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO cln_test " & _
"( my_date, departure, village_code, village_name, category, ceil, sold, occ, readdate ) " & _
" SELECT DISTINCT " & _
" left([departure],2) & '-' & mid([departure],3,3) " & _
" & '-' & right([departure],4), [departure], [village_code], " & _
" [village_name], [category], [ceil], [sold], [occ], [readdate] " & _
" FROM availability " & _
" WHERE departure<>' ' " & _
" And readdate = (select max(readdate) from availability)"
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from cln_test " & _
" where ceil = 0 and sold = 0 "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO comp_day " & _
" ( my_date, readdate, village_code, village_name, category, ceil, sold ) " & _
" SELECT [my_date], [readdate], [village_code], " & _
" [village_name], [category], sum([ceil]) AS sum_ceil, " & _
" sum([sold]) AS sum_sold " & _
" FROM cln_test " & _
" WHERE readdate = (select max(readdate) from cln_test) " & _
" GROUP BY [readdate], [my_date], [village_code], " & _
" [village_name], [category] "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT " & _
" ( mon_readdate, village_code, village_name, " & _
" departure, category, ceil, mon_sold, cur_readdate, " & _
" cur_sold, movement, avail, wks_to_dept ) " & _
" SELECT m.readdate, m.village_code, m.village_name, " & _
" m.my_date AS departure, m.category, m.ceil, m.sold, " & _
" c.readdate, c.sold, c.sold-m.sold AS movement, " & _
" c.ceil-c.sold AS avail, round((m.my_date-date())/7,0) AS wks_to_dept " & _
" FROM monday AS m, comp_day AS c " & _
" WHERE m.my_date = c.my_date " & _
" And m.village_code = c.village_code " & _
" And m.Category = c.Category " & _
" ORDER BY m.village_code, m.my_date, m.category "
cmd1.CommandText = sClean
cmd1.Execute
'' Part II Add Week no and sell thru
sClean = " delete from movement_II "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT_II " & _
" SELECT M.MON_READDATE AS MON_READDATE, " & _
" M.VILLAGE_CODE AS VILLAGE_CODE, M.VILLAGE_NAME AS VILLAGE_NAME, " & _
" M.DEPARTURE AS DEPARTURE, M.CATEGORY AS CATEGORY, M.CEIL AS CEIL, " & _
" M.MON_SOLD AS MON_SOLD, M.CUR_READDATE AS CUR_READDATE, " & _
" M.CUR_SOLD AS CUR_SOLD, M.MOVEMENT AS MOVEMENT, M.AVAIL AS AVAIL, " & _
" M.WKS_TO_DEPT AS WKS_TO_DEPT, MD.WEEK_NO AS WEEK_NO, " & _
" MD.WEEK_DAY AS WEEK_DAY " & _
" FROM MOVEMENT AS M, MOVEMENT_DATES AS MD " & _
" WHERE M.DEPARTURE=MD.DEPARTURE "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from sell_thru_temp "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO SELL_THRU_TEMP " & _
" SELECT [village_code] AS village_code, " & _
" [CATEGORY] AS CATEGORY, [WEEK_NO] AS WEEK_NO, " & _
" min([avaIL]) AS SELL_THRU " & _
" FROM movement_II " & _
" GROUP BY [village_code], [CATEGORY], [WEEK_NO] "
cmd1.CommandText = sClean
cmd1.Execute
If Date Mod 7 = 2 Then
sClean = " delete from movement_weekly "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT_WEEKLY " & _
" SELECT M.MON_READDATE AS MON_READDATE, " & _
" M.VILLAGE_CODE AS VILLAGE_CODE, " & _
" M.VILLAGE_NAME AS VILLAGE_NAME, " & _
" M.DEPARTURE AS DEPARTURE, M.CATEGORY AS CATEGORY, " & _
" M.CEIL AS CEIL, M.MON_SOLD AS MON_SOLD, " & _
" M.CUR_READDATE AS CUR_READDATE, M.CUR_SOLD AS CUR_SOLD, " & _
" M.MOVEMENT AS MOVEMENT, M.AVAIL AS AVAIL, " & _
" M.WKS_TO_DEPT AS WKS_TO_DEPT, M.WEEK_NO AS WEEK_NO, " & _
" M.WEEK_DAY AS WEEK_DAY, S.SELL_THRU AS SELL_THRU " & _
" FROM MOVEMENT_II AS M, SELL_THRU_TEMP AS S " & _
" WHERE M.VILLAGE_CODE=S.VILLAGE_CODE " & _
" And M.CATEGORY=S.CATEGORY " & _
" And M.WEEK_NO=S.WEEK_NO "
cmd1.CommandText = sClean
cmd1.Execute
Else
sClean = " delete from movement_fnl "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT_FNL " & _
" SELECT M.MON_READDATE AS MON_READDATE, " & _
" M.VILLAGE_CODE AS VILLAGE_CODE, " & _
" M.VILLAGE_NAME AS VILLAGE_NAME, " & _
" M.DEPARTURE AS DEPARTURE, M.CATEGORY AS CATEGORY, " & _
" M.CEIL AS CEIL, M.MON_SOLD AS MON_SOLD, " & _
" M.CUR_READDATE AS CUR_READDATE, M.CUR_SOLD AS CUR_SOLD, " & _
" M.MOVEMENT AS MOVEMENT, M.AVAIL AS AVAIL, " & _
" M.WKS_TO_DEPT AS WKS_TO_DEPT, M.WEEK_NO AS WEEK_NO, " & _
" M.WEEK_DAY AS WEEK_DAY, S.SELL_THRU AS SELL_THRU " & _
" FROM MOVEMENT_II AS M, SELL_THRU_TEMP AS S " & _
" WHERE M.VILLAGE_CODE=S.VILLAGE_CODE " & _
" And M.CATEGORY=S.CATEGORY " & _
" And M.WEEK_NO=S.WEEK_NO "
cmd1.CommandText = sClean
cmd1.Execute
End If
End Sub
Sub MOVEMENT_TUES()
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
sClean = "DELETE * FROM cln_test"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM MOVEMENT"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM comp_day"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM MONDAY"
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO cln_test " & _
"( my_date, departure, village_code, village_name, category, ceil, sold, occ, readdate ) " & _
" SELECT DISTINCT " & _
" left([departure],2) & '-' & mid([departure],3,3) " & _
" & '-' & right([departure],4), [departure], [village_code], " & _
" [village_name], [category], [ceil], [sold], [occ], [readdate] " & _
" FROM availability " & _
" WHERE departure<>' ' " & _
" And readdate = (select max(readdate) from availability)"
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from cln_test " & _
" where ceil = 0 and sold = 0 "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO comp_day " & _
" ( my_date, readdate, village_code, village_name, category, ceil, sold ) " & _
" SELECT [my_date], [readdate], [village_code], " & _
" [village_name], [category], sum([ceil]) AS sum_ceil, " & _
" sum([sold]) AS sum_sold " & _
" FROM cln_test " & _
" WHERE readdate = (select max(readdate) from cln_test) " & _
" GROUP BY [readdate], [my_date], [village_code], " & _
" [village_name], [category] "
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM cln_test"
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO cln_test " & _
"( my_date, departure, village_code, village_name, category, ceil, sold, occ, readdate ) " & _
" SELECT DISTINCT left([departure],2) & '-' & mid([departure],3,3) " & _
" & '-' & right([departure],4), [departure], [village_code], [village_name], [category], [ceil], [sold], [occ], [readdate] " & _
" from availability " & _
" WHERE departure<>' ' " & _
" And readdate = " & _
" ( select max(readdate) " & _
" from availability " & _
" where readdate < " & _
" (select max(readdate) from availability)) "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from cln_test " & _
" where ceil = 0 and sold = 0 "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MONDAY " & _
" ( my_date, readdate, village_code, village_name, category, ceil, sold ) " & _
" SELECT [my_date], [readdate], [village_code], " & _
" [village_name], [category], sum([ceil]) AS sum_ceil, " & _
" sum([sold]) AS sum_sold " & _
" FROM cln_test " & _
" WHERE readdate = (select max(readdate) from cln_test) " & _
" GROUP BY [readdate], [my_date], [village_code], " & _
" [village_name], [category] "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT " & _
" ( mon_readdate, village_code, village_name, " & _
" departure, category, ceil, mon_sold, cur_readdate, " & _
" cur_sold, movement, avail, wks_to_dept ) " & _
" SELECT m.readdate, m.village_code, m.village_name, " & _
" m.my_date AS departure, m.category, m.ceil, m.sold, " & _
" c.readdate, c.sold, c.sold-m.sold AS movement, " & _
" c.ceil-c.sold AS avail, round((m.my_date-date())/7,0) AS wks_to_dept " & _
" FROM monday AS m, comp_day AS c " & _
" WHERE m.my_date = c.my_date " & _
" And m.village_code = c.village_code " & _
" And m.Category = c.Category " & _
" ORDER BY m.village_code, m.my_date, m.category "
cmd1.CommandText = sClean
cmd1.Execute
'' Part II Add Week no and sell thru
sClean = " delete from movement_II "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT_II " & _
" SELECT M.MON_READDATE AS MON_READDATE, " & _
" M.VILLAGE_CODE AS VILLAGE_CODE, M.VILLAGE_NAME AS VILLAGE_NAME, " & _
" M.DEPARTURE AS DEPARTURE, M.CATEGORY AS CATEGORY, M.CEIL AS CEIL, " & _
" M.MON_SOLD AS MON_SOLD, M.CUR_READDATE AS CUR_READDATE, " & _
" M.CUR_SOLD AS CUR_SOLD, M.MOVEMENT AS MOVEMENT, M.AVAIL AS AVAIL, " & _
" M.WKS_TO_DEPT AS WKS_TO_DEPT, MD.WEEK_NO AS WEEK_NO, " & _
" MD.WEEK_DAY AS WEEK_DAY " & _
" FROM MOVEMENT AS M, MOVEMENT_DATES AS MD " & _
" WHERE M.DEPARTURE=MD.DEPARTURE "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from sell_thru_temp "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO SELL_THRU_TEMP " & _
" SELECT [village_code] AS village_code, " & _
" [CATEGORY] AS CATEGORY, [WEEK_NO] AS WEEK_NO, " & _
" min([avaIL]) AS SELL_THRU " & _
" FROM movement_II " & _
" GROUP BY [village_code], [CATEGORY], [WEEK_NO] "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " delete from movement_fnl "
cmd1.CommandText = sClean
cmd1.Execute
sClean = " INSERT INTO MOVEMENT_FNL " & _
" SELECT M.MON_READDATE AS MON_READDATE, " & _
" M.VILLAGE_CODE AS VILLAGE_CODE, " & _
" M.VILLAGE_NAME AS VILLAGE_NAME, " & _
" M.DEPARTURE AS DEPARTURE, M.CATEGORY AS CATEGORY, " & _
" M.CEIL AS CEIL, M.MON_SOLD AS MON_SOLD, " & _
" M.CUR_READDATE AS CUR_READDATE, M.CUR_SOLD AS CUR_SOLD, " & _
" M.MOVEMENT AS MOVEMENT, M.AVAIL AS AVAIL, " & _
" M.WKS_TO_DEPT AS WKS_TO_DEPT, M.WEEK_NO AS WEEK_NO, " & _
" M.WEEK_DAY AS WEEK_DAY, S.SELL_THRU AS SELL_THRU " & _
" FROM MOVEMENT_II AS M, SELL_THRU_TEMP AS S " & _
" WHERE M.VILLAGE_CODE=S.VILLAGE_CODE " & _
" And M.CATEGORY=S.CATEGORY " & _
" And M.WEEK_NO=S.WEEK_NO "
cmd1.CommandText = sClean
cmd1.Execute
End Sub
Sub send_allert_vbs()
'Sending a text email using a remote server
sTo = "Reginald.LeValle@clubmed.com,benoit.montigny@clubmed.com,Andrew.Forrest@clubmed.com"
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Winter Tetris, Movement and Inventory Sheets are Ready"
objMessage.Sender = "cms028@clubmed.com"
objMessage.To = sTo
sMessage = "Winter Tetris, Movement and Inventory Sheets have been updated." & VBA.vbNewLine
sMessage = sMessage & "Please go to DSS Reports."
sMessage = sMessage & VBA.vbNewLine & VBA.vbNewLine & "Here is a link: " & VBA.vbNewLine & "<file://t:\dss\DSS Reports.xls>"
sMessage = sMessage & VBA.vbNewLine & VBA.vbNewLine
sMessage = sMessage & "**This is an automated Email. Please do not respond**"
objMessage.TextBody = sMessage
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.globalcrossing.net"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "cgassv0012"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
End Sub
Sub cleanDBall()
Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = CurrentProject.Connection
sClean = "DELETE * FROM Availability"
cmd1.CommandText = sClean
cmd1.Execute
sClean = "DELETE * FROM Availability"
cmd1.CommandText = sClean
cmd1.Execute
End Sub
