Attribute VB_Name = "UPDATE" Dim vDb As Database Public Sub UPDATE_DAY() Set FSO = CreateObject("Scripting.FileSystemObject") Dim Fileout As Object Set Fileout = FSO.CreateTextFile(ThisWorkbook.path & "\log.txt", True, False) Fileout.Close If FSO.FolderExists(ThisWorkbook.path & "\temp_db") = True Then FSO.deletefolder (ThisWorkbook.path & "\temp_db") End If FSO.CreateFolder (ThisWorkbook.path & "\temp_db") 'crea il db Dim accessApp As Access.Application Set accessApp = New Access.Application accessApp.DBEngine.CreateDatabase ThisWorkbook.path & "\temp_db\DB_DAY.accdb", DB_LANG_GENERAL accessApp.Quit Call sub_UPDATE_GEMMA Call sub_UPDATE_VALUTAZIONI Call sub_UPDATE_MOSSERVATORIO_Schede Call sub_UPDATE_GEMMA_ONAIRPLUS Call sManutenzione_InfoGlobal Call sManutenzione_CalRicStato FileCopy ThisWorkbook.path & "\temp_db\DB_DAY.accdb", "\\mediaset.it\share\Indirizzo_Controllo_Risorse\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker\DB_DAY.accdb" FSO.deletefolder (ThisWorkbook.path & "\temp_db") If FSO.FolderExists(ThisWorkbook.path & "\LOG") = False Then FSO.CreateFolder (ThisWorkbook.path & "\LOG") End If FileCopy ThisWorkbook.path & "\log.txt", ThisWorkbook.path & "\LOG\" & Format(Date, "yyyymmdd") & "_" & Format(Time(), "hhmm") & ".txt" Kill ThisWorkbook.path & "\log.txt" ThisWorkbook.Saved = True Application.Quit End Sub Public Sub UPDATE_WEEK() Set FSO = CreateObject("Scripting.FileSystemObject") Dim Fileout As Object Set Fileout = FSO.CreateTextFile(ThisWorkbook.path & "\log.txt", True, False) Fileout.Close If FSO.FolderExists(ThisWorkbook.path & "\temp_db") = True Then FSO.deletefolder (ThisWorkbook.path & "\temp_db") End If FSO.CreateFolder (ThisWorkbook.path & "\temp_db") 'crea i db Dim accessApp As Access.Application Set accessApp = New Access.Application accessApp.DBEngine.CreateDatabase ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", DB_LANG_GENERAL accessApp.DBEngine.CreateDatabase ThisWorkbook.path & "\temp_db\DB_WEEK.accdb", DB_LANG_GENERAL accessApp.Quit Set accessApp = Nothing Call sub_UPDATE_SNAPSHOT Call sub_UPDATE_CUSTOM_ANAGRAFICA Call sub_UPDATE_DIRITTI Call sub_UPDATE_CUSTOM_EMESSO Call sub_UPDATE_BOXOFFICE FileCopy ThisWorkbook.path & "\temp_db\DB_WEEK.accdb", "\\mediaset.it\share\Indirizzo_Controllo_Risorse\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker\DB_WEEK.accdb" FSO.deletefolder (ThisWorkbook.path & "\temp_db") FileCopy ThisWorkbook.path & "\log.txt", ThisWorkbook.path & "\LOG\" & Format(Date, "yyyymmdd") & "_" & Format(Time(), "hhmm") & "_week.txt" Kill ThisWorkbook.path & "\log.txt" 'Call UPDATE_DAY If FSO.FolderExists(ThisWorkbook.path & "\LOG") = False Then FSO.CreateFolder (ThisWorkbook.path & "\LOG") End If ThisWorkbook.Saved = True Application.Quit End Sub Public Sub sCompattaDb(path, nomeFile) '***************************************************************************************** 'Compatta il database 'Inserire il percorso e il nome del file da compattare '***************************************************************************************** Application.DisplayAlerts = False DBEngine.CompactDatabase path & "\" & nomeFile, path & "\" & "NEW" & nomeFile DBEngine.Idle Kill path & "\" & nomeFile Name path & "\" & "NEW" & nomeFile As path & "\" & nomeFile Application.DisplayAlerts = True End Sub Public Sub sub_UPDATE_COMPATTA_DB() On Error GoTo errore: Call sUpdater("Start", "COMPATTA_DB") path = "\\mediaset.it\share\Indirizzo_Controllo_Risorse\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker\" nomeFile = "db_warehouse.accdb" Call sCompattaDb(path, nomeFile) Call sUpdater("End", "COMPATTA_DB") Exit Sub errore: If Err.Number = 3000 Then Resume Else 'MsgBox (Err.Description) End If End Sub Public Sub sUpdater(Evento, NomeUpdate) 'Evento = "Start" o "End") On Error GoTo errore: Set FSO = CreateObject("Scripting.FileSystemObject") If Evento = "Start" Then If FSO.FolderExists(ThisWorkbook.path & "\temp") = True Then FSO.deletefolder (ThisWorkbook.path & "\temp") End If FSO.CreateFolder (ThisWorkbook.path & "\temp") strFile_Path = ThisWorkbook.path & "\log.txt" Open strFile_Path For Append As #1 Write #1, NomeUpdate & " start:" & Date & " " & Time() Close #1 FileCopy ThisWorkbook.path & "\UPDATE.accdb", ThisWorkbook.path & "\temp\UPDATE.accdb" Set vDb = OpenDatabase(ThisWorkbook.path & "\temp\UPDATE.accdb", False, False) End If If Evento = "End" Then On Error Resume Next vDb.Close On Error GoTo errore: '-------------------------------------------------------------------------- 'scrive nella directory la data aggiornamento--------------------- path = "\\mediaset.it\share\Indirizzo_Controllo_Risorse\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker\UPDATES\log\" Dim Fileout As Object On Error Resume Next Kill path & "UPDATE_" & NomeUpdate & "*.txt" On Error GoTo errore: Set Fileout = FSO.CreateTextFile(path & "UPDATE_" & NomeUpdate & " al " & Format(Date, "dd-mm-yy") & ".txt", True, True) '------------------------------------------------------ FSO.deletefolder (ThisWorkbook.path & "\temp") strFile_Path = ThisWorkbook.path & "\log.txt" Open strFile_Path For Append As #1 Write #1, NomeUpdate & " end:" & Date & " " & Time() Close #1 End If Exit Sub errore: If Err.Number = 58 Or Err.Number = 4045 Or Err.Number = 70 Then Resume Else MsgBox Err.Number MsgBox Err.Description End If End Sub Public Sub sub_UPDATE_GEMMA() On Error GoTo errore: Call sUpdater("Start", "GEMMA") vDb.Execute ("INSERT INTO NEW_GEMMA ( A_STATO, KEY_COD, A_TITOLO, A_DATA, A_DISTRIBUTORE, A_TIPOLOGIA, A_TIPO, A_AUTORE_REGISTA, A_CAST, A_Codice_Prodotto, [A_Cod IMDB],A_EPISODIO, A_SUPPORTO, [A_Note Supporti], A_DEADLINE, [A_Note Pubbliche], [A_Note Private],[A_Acquistato_Venduto], A_C5, A_I1, A_R4, A_LA5, A_I2, A_IRIS, A_TOP, A_FOC, A_C20, A_CI34, A_C27, A_CIN, A_INF, A_EMO, A_ENE, A_COM, A_STO, A_CRI, A_ACT, V_STATO, V_RDA, V_C5, V_I1, V_R4, V_LA5, V_I2, V_IRIS, V_TOP, V_FOC, V_C20, V_CI34,V_C27, V_CIN, V_INF, V_EMO, V_ENE, V_COM, V_STO, V_CRI, V_ACT ) " & _ "SELECT estr_gemma.A_STATO,estr_gemma.[A_ID], estr_gemma.A_TITOLO, estr_gemma.A_DATA, estr_gemma.A_DISTRIBUTORE, estr_gemma.A_TIPOLOGIA, estr_gemma.A_TIPO, estr_gemma.A_AUTORE_REGISTA, estr_gemma.A_CAST, estr_gemma.A_CODICE_PRODOTTO, estr_gemma.A_COD_IMDB,estr_gemma.A_EPISODIO, estr_gemma.A_SUPPORTO, estr_gemma.A_NOTE_SUPPORTO, estr_gemma.A_DEADLINE, estr_gemma.A_NOTE_PUBBLICHE, estr_gemma.A_NOTE_PRIVATE, estr_gemma.A_ACQUISTATO_VENDUTO,estr_gemma.A_C5, estr_gemma.A_I1, estr_gemma.A_R4, estr_gemma.A_LA5, estr_gemma.A_I2, estr_gemma.A_IRIS, estr_gemma.A_TOP, estr_gemma.A_FOC, estr_gemma.A_C20, estr_gemma.A_CI34,estr_gemma.A_C27, estr_gemma.A_CIN, estr_gemma.A_INF, estr_gemma.A_EMO, estr_gemma.A_ENE, estr_gemma.A_COM, estr_gemma.A_STO, estr_gemma.A_CRI, estr_gemma.A_ACT, estr_gemma.V_STATO, " & _ "estr_gemma.V_RDA, estr_gemma.V_C5, estr_gemma.V_I1, estr_gemma.V_R4, estr_gemma.V_LA5, estr_gemma.V_I2, estr_gemma.V_IRIS, estr_gemma.V_TOP, estr_gemma.V_FOC, estr_gemma.V_C20, estr_gemma.V_CI34,estr_gemma.V_C27, estr_gemma.V_CIN, estr_gemma.V_INF, estr_gemma.V_EMO, estr_gemma.V_ENE, estr_gemma.V_COM, estr_gemma.V_STO, estr_gemma.V_CRI, estr_gemma.V_ACT " & _ "FROM estr_gemma;") 'aggiunge il "!" se non è stato valutato ed è nello stato IN CORSO Set rs = vDb.OpenRecordset("NEW_GEMMA") For n = 1 To rs.Fields.Count - 1 If Left(rs.Fields(n).Name, 2) = "V_" And rs.Fields(n).Name <> "V_Stato" And rs.Fields(n).Name <> "V_RDA" Then vDb.Execute ("UPDATE NEW_GEMMA SET NEW_GEMMA." & rs.Fields(n).Name & " = '!' " & _ "WHERE (((NEW_GEMMA.V_Stato)='IN CORSO') AND ((NEW_GEMMA." & Replace(rs.Fields(n).Name, "V_", "A_") & ")<>'0') AND ((NEW_GEMMA." & rs.Fields(n).Name & ") Is Null));") End If Next n rs.Close 'aggiorna la prima tv free vDb.Execute ("SELECT NEW_GEMMA.[A_Cod IMDB], Min(DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PG_DATA) AS MinDiEM_PG_DATA INTO temp " & _ "FROM NEW_GEMMA INNER JOIN DB_WEEK_CUSTOM_ANAGR_ORIZ ON NEW_GEMMA.[A_Cod IMDB] = DB_WEEK_CUSTOM_ANAGR_ORIZ.IMDB_CODICE " & _ "WHERE (((DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PG_DATA) Is Not Null)) " & _ "GROUP BY NEW_GEMMA.[A_Cod IMDB];") vDb.Execute ("UPDATE (NEW_GEMMA INNER JOIN temp ON NEW_GEMMA.[A_Cod IMDB] = temp.[A_Cod IMDB]) INNER JOIN DB_WEEK_CUSTOM_ANAGR_ORIZ ON (temp.MinDiEM_PG_DATA = DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PG_DATA) AND (temp.[A_Cod IMDB] = DB_WEEK_CUSTOM_ANAGR_ORIZ.IMDB_CODICE) SET NEW_GEMMA.M_1TV_RETE = [EM_PG_RETE], NEW_GEMMA.M_1TV_DATA = [EM_PG_DATA], NEW_GEMMA.M_1TV_HI = [EM_PG_HI], NEW_GEMMA.M_1TV_FASCIA = [EM_PG_FASCIA], NEW_GEMMA.M_1TV_AUD = [EM_PG_AUD], NEW_GEMMA.M_1TV_SHA = [EM_PG_SHARE];") vDb.Execute ("SELECT NEW_GEMMA.[A_Cod IMDB], Min(DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PT_DATA) AS MinDiEM_PT_DATA INTO temp " & _ "FROM NEW_GEMMA INNER JOIN DB_WEEK_CUSTOM_ANAGR_ORIZ ON NEW_GEMMA.[A_Cod IMDB] = DB_WEEK_CUSTOM_ANAGR_ORIZ.IMDB_CODICE " & _ "WHERE (((DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PT_DATA) Is Not Null)) " & _ "GROUP BY NEW_GEMMA.[A_Cod IMDB];") vDb.Execute ("UPDATE (NEW_GEMMA INNER JOIN temp AS temp_1 ON NEW_GEMMA.[A_Cod IMDB] = temp_1.[A_Cod IMDB]) INNER JOIN DB_WEEK_CUSTOM_ANAGR_ORIZ ON (temp_1.MinDiEM_PT_DATA = DB_WEEK_CUSTOM_ANAGR_ORIZ.EM_PT_DATA) AND (temp_1.[A_Cod IMDB] = DB_WEEK_CUSTOM_ANAGR_ORIZ.IMDB_CODICE) SET NEW_GEMMA.M_1TV_RETE = [EM_PT_RETE], NEW_GEMMA.M_1TV_DATA = [EM_PT_DATA], NEW_GEMMA.M_1TV_HI = [EM_PT_HI], NEW_GEMMA.M_1TV_FASCIA = [EM_PT_FASCIA], NEW_GEMMA.M_1TV_AUD = [EM_PT_AUD], NEW_GEMMA.M_1TV_SHA = [EM_PT_SHARE] " & _ "WHERE (((NEW_GEMMA.M_1TV_DATA) Is Null)) OR (([EM_PG_DATA]<[M_1TV_DATA]));") vDb.Close Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\DB_DAY.accdb", "GEMMA", acTable, "NEW_GEMMA" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True 'ricopia GEMMA su GemmaLoader (Acquisti) Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase "\\mediaset.it\cologno\icr_acquisti\GemmaLoader\GemmaLoader.accdb", False, "maugag" MsAxs.DoCmd.DeleteObject acTable, "GEMMA" MsAxs.DoCmd.TransferDatabase acImport, "Microsoft Access", ThisWorkbook.path & "\temp\UPDATE.accdb", acTable, "NEW_GEMMA", "GEMMA", False Call sUpdater("End", "GEMMA") Exit Sub End errore: If Err.Number = 3010 Then vDb.Execute ("drop table temp") Resume ElseIf Err.Number = 53 Then MsgBox Err.Description Resume Next ElseIf Err.Number = 3000 Then Resume Else MsgBox Err.Description End If End Sub Public Sub sub_UPDATE_VALUTAZIONI(Optional NonSchedulato As Boolean) On Error GoTo errore: Call sUpdater("Start", "VALUTAZIONI") vDb.Execute ("INSERT INTO NEW_VALUTAZIONI ( IMDB, DATA, ORIGINE ) " & _ "SELECT GEMMA.[A_Cod IMDB], Max(GEMMA.A_Data) AS MaxDiA_Data, 'G' AS Espr1 " & _ "FROM GEMMA " & _ "GROUP BY GEMMA.[A_Cod IMDB], 'G' " & _ "HAVING (((GEMMA.[A_Cod IMDB]) Like 'tt*'));") vDb.Execute ("DELETE NEW_VALUTAZIONI.*, NEW_VALUTAZIONI.DATA " & _ "FROM NEW_VALUTAZIONI INNER JOIN LINKER_VALUTAZIONE ON NEW_VALUTAZIONI.IMDB = LINKER_VALUTAZIONE.COD_IMDB " & _ "WHERE (((NEW_VALUTAZIONI.DATA)<[LINKER_VALUTAZIONE]![DATA]));") vDb.Execute ("INSERT INTO NEW_VALUTAZIONI ( FORNITORE, IMDB, DATA, C5, I1, R4, LA5, I2, IRIS, TOPCRIME, FOCUS, C20, CINE34, TWENTYSEVEN, ORIGINE ) " & _ "SELECT FORNITORE, COD_IMDB, DATA,C5,I1,R4,LA5,I2,IRIS,TOPCRIME, FOCUS,C20,CINE34,TWENTYSEVEN, 'S' AS Espr1 " & _ "FROM LINKER_VALUTAZIONE;") vDb.Execute ("UPDATE GEMMA INNER JOIN NEW_VALUTAZIONI ON (GEMMA.[A_Cod IMDB] = NEW_VALUTAZIONI.IMDB) AND (GEMMA.A_Data = NEW_VALUTAZIONI.DATA) SET NEW_VALUTAZIONI.GEMMA = [GEMMA]![KEY_COD], NEW_VALUTAZIONI.FORNITORE = [A_Distributore], NEW_VALUTAZIONI.RDA = [V_RDA], NEW_VALUTAZIONI.C5 = [V_C5], NEW_VALUTAZIONI.I1 = [V_I1], NEW_VALUTAZIONI.R4 = [V_R4], NEW_VALUTAZIONI.LA5 = [V_LA5], NEW_VALUTAZIONI.I2 = [V_I2], NEW_VALUTAZIONI.IRIS = [V_IRIS], NEW_VALUTAZIONI.TOPCRIME = [V_TOP], NEW_VALUTAZIONI.FOCUS = [V_FOC], NEW_VALUTAZIONI.C20 = [V_C20], NEW_VALUTAZIONI.CINE34 = [V_CI34], NEW_VALUTAZIONI.TWENTYSEVEN = [V_C27], NEW_VALUTAZIONI.SUPPORTO = [A_Supporto] " & _ "WHERE (((NEW_VALUTAZIONI.ORIGINE)='G'));") 'aggiorna le valutazioni extra Gemma inserite da ICR vDb.Execute ("INSERT INTO NEW_VALUTAZIONI ( IMDB, ORIGINE, DATA, C5, I1, R4, LA5, I2, IRIS, TOPCRIME, FOCUS, C20, CINE34, TWENTYSEVEN ) " & _ "SELECT tabValutazioniExtraGemma.IMDB, 'I' AS Espr1, Format(tabValutazioniExtraGemma.data_creazione,'dd/mm/yyyy'), tabValutazioniExtraGemma.C5, tabValutazioniExtraGemma.I1, tabValutazioniExtraGemma.R4, tabValutazioniExtraGemma.LA5, tabValutazioniExtraGemma.I2, tabValutazioniExtraGemma.IRIS, tabValutazioniExtraGemma.TOPCRIME, tabValutazioniExtraGemma.FOCUS, tabValutazioniExtraGemma.C20, tabValutazioniExtraGemma.CINE34, tabValutazioniExtraGemma.TWENTYSEVEN " & _ "FROM tabValutazioniExtraGemma LEFT JOIN NEW_VALUTAZIONI ON tabValutazioniExtraGemma.IMDB = NEW_VALUTAZIONI.IMDB " & _ "WHERE (((NEW_VALUTAZIONI.IMDB) Is Null));") vDb.Execute ("UPDATE NEW_VALUTAZIONI INNER JOIN tabValutazioniExtraGemma ON NEW_VALUTAZIONI.IMDB = tabValutazioniExtraGemma.IMDB SET NEW_VALUTAZIONI.C5 = '-', NEW_VALUTAZIONI.I1 = '-', NEW_VALUTAZIONI.R4 = '-', NEW_VALUTAZIONI.LA5 = '-', NEW_VALUTAZIONI.I2 = '-', NEW_VALUTAZIONI.IRIS = '-', NEW_VALUTAZIONI.TOPCRIME = '-', NEW_VALUTAZIONI.FOCUS = '-', NEW_VALUTAZIONI.C20 = '-', NEW_VALUTAZIONI.CINE34 = '-', NEW_VALUTAZIONI.TWENTYSEVEN = '-', NEW_VALUTAZIONI.C37 = '-' " & _ "WHERE (((tabValutazioniExtraGemma.NoIcr)=True) AND ((NEW_VALUTAZIONI.ORIGINE)='I'));") Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\DB_DAY.accdb", "VALUTAZIONI", acTable, "NEW_VALUTAZIONI" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True Call sUpdater("End", "VALUTAZIONI") Exit Sub errore: If Err.Number = 3010 Then vDb.Execute ("drop table " & Mid(Err.Description, 10, InStr(Mid(Err.Description, 10), "'") - 1)) Resume ElseIf Err.Number = 3000 Or Err.Number = 4045 Then Resume ElseIf Err.Number = 91 Then Call basUtility.sRicollegaDb Resume Else MsgBox "Si è verificato un errore: " & Err.Description End If End Sub Public Sub sub_UPDATE_MOSSERVATORIO_Schede() Call sUpdater("Start", "MOSSERVATORIO_Schede") 'path_SANDBOX = "C:\IcrMonitor\sandbox\DOCKER_MOSSERVATORIO_schede\" 'Set vDb = OpenDatabase(path_SANDBOX & "MOSSERVATORIO_Schede_TEMP.accdb", False, False) vDb.Execute ("INSERT INTO SCHEDA_PRODOTTO ( CodOss, titolo, paese, genere, tipologia, anno, rete, stato ) " & _ "SELECT [osservatorio].codice, [osservatorio].titolo, [osservatorio].paese, [osservatorio].genere, [osservatorio].tipologia, [osservatorio].anno, Left([rete],255) AS Espr1, [osservatorio].stato " & _ "FROM [osservatorio];") Set rs = vDb.OpenRecordset("SELECT SCHEDA_PRODOTTO.* " & _ "FROM SCHEDA_PRODOTTO;") If Not rs.EOF Then rs.MoveLast If rs.RecordCount > 30000 Then rs.Close 'sintassi corretta per copia tabella da Access a Access Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject "\\mediaset.it\cologno\osservatorio_progetti\MonitorOsservatorio\db.accdb", "SCHEDA_PRODOTTO", acTable, "SCHEDA_PRODOTTO" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True End If End If 'Copia che serve a Osservatorio (in particolare alla Francesca Russo) a consultare le schede tramite il file Schede.xlsx FileCopy "\\Mediaset.it\share\Indirizzo_controllo_risorse\SOFTWARE\SCHEDULATORE\INPUT\osservatorio.txt", "\\mediaset.it\cologno\osservatorio_progetti\MonitorOsservatorio\osservatorio.txt" Call sUpdater("End", "MOSSERVATORIO_Schede") End Sub Public Sub sub_UPDATE_SNAPSHOT() On Error GoTo errore: Call sUpdater("Start", "SNAPSHOT") '************************************************************************************************************************************* 'vengono scaricati i dati solo delle tipologie indicate nella tabella DECOD_TIPOLOGIA,campo SCARICO_DATI '************************************************************************************************************************************* 'TABELLE QLIK 'QLIK_SUPERSERIE vDb.Execute ("INSERT INTO NEW_QLIK_SUPERSERIE ( SUPERSERIE, RIFER, COD_SUPERSERIE ) " & _ "SELECT estr_prod.SUPERSERIE_DESCR, estr_prod.PRODOTTO, estr_prod.SUPERSERIE_ID " & _ "From estr_prod " & _ "WHERE (((estr_prod.SUPERSERIE_ID) Is Not Null));") 'QLIK_EDIZIONI 'aggiorna la tabella di decodifica della tipologia vDb.Execute ("INSERT INTO DECOD_TIPOLOGIA ( TIPOL_ESTESA ) " & _ "SELECT estr_prod.TIPOLOGIA " & _ "From estr_prod " & _ "WHERE (((estr_prod.TIPOLOGIA)<>'TIPOLOGIA'));") 'aggiorna la tabella di decodifica della provenienza vDb.Execute ("INSERT INTO DECOD_PROVENIENZA ( PROVENIENZA ) " & _ "SELECT estr_prod.PROVENIENZA " & _ "From estr_prod " & _ "GROUP BY estr_prod.PROVENIENZA " & _ "HAVING (((estr_prod.PROVENIENZA)<>'PROVENIENZA'));") vDb.Execute ("INSERT INTO NEW_ICR_BD_TR040050 ( CCPRODEDIZ, TCDURATANOM, PAESE1, PAESE2, PAESE3, CCCROMIA, CCNUMELEM, CCVALGEST, FKR0410_CCPROD, CCAAPRODZ, CCGENERE1, CCGENERE2, CCGENERE3, CCPROVENIENZA, XCTARGET, FKR0490_CCTIPOL ) " & _ "SELECT estr_prod.EDIZIONE, estr_prod.DURATA, estr_prod.PAESE1, estr_prod.PAESE2, estr_prod.PAESE3, QLIK_DECOD_CROMIA.CCCROMIA, estr_prod.NUM_EPISODI, ICR_BD_TR990270.CCVALGEST, estr_prod.PRODOTTO, estr_prod.ANNO_PRODUZIONE, ICR_BD_TR990100.CCGENERE, ICR_BD_TR990100_1.CCGENERE, ICR_BD_TR990100_2.CCGENERE, estr_prod.PROVENIENZA, estr_prod.VM, DECOD_TIPOLOGIA.TIPOL " & _ "FROM ((((((estr_prod LEFT JOIN QLIK_DECOD_CROMIA ON estr_prod.CROMIA = QLIK_DECOD_CROMIA.QLIK_CROMIA) LEFT JOIN ICR_BD_TR990270 ON estr_prod.VEG = ICR_BD_TR990270.XCVEG) LEFT JOIN ICR_BD_TR990100 ON estr_prod.GENERE1 = ICR_BD_TR990100.XCGENERE) LEFT JOIN ICR_BD_TR990100 AS ICR_BD_TR990100_1 ON estr_prod.GENERE2 = ICR_BD_TR990100_1.XCGENERE) LEFT JOIN ICR_BD_TR990100 AS ICR_BD_TR990100_2 ON estr_prod.GENERE3 = ICR_BD_TR990100_2.CCGENERE) LEFT JOIN DECOD_PROVENIENZA ON estr_prod.PROVENIENZA = DECOD_PROVENIENZA.PROVENIENZA) INNER JOIN DECOD_TIPOLOGIA ON estr_prod.TIPOLOGIA = DECOD_TIPOLOGIA.TIPOL_ESTESA " & _ "WHERE (((estr_prod.EDIZIONE) Is Not Null And (estr_prod.EDIZIONE)<>'EDIZIONE') AND ((DECOD_TIPOLOGIA.SCARICO_DATI)='X'));") 'QLIK_EMESSO vDb.Execute ("INSERT INTO NEW_ICR_BD_TKBLS010 ( CCRETETEL, DCDATGIO, TCORAINIZ, TCORAFINE, CCPROD, CCPRODEDIZ, NCELEM, QCAUDMED, PCSHAREA, TCDURNET, TCDURLORDA, FCPRIMAVIS, NCPARTE, FKR0450_CCTIPOL, CCFASCIA ) " & _ "SELECT estr_emesso.CCRETETEL, Right([dcdatgio],2) & '/' & Mid([dcdatgio],5,2) & '/' & Left([dcdatgio],4) AS DATA, Left([TCORAINIZ],2) & Mid([tcorainiz],4,2) & Right([TCORAINIZ],2) AS HI, Left([TCORAFINE],2) & Mid([tcoraFINE],4,2) & Right([TCORAFINE],2) AS HF, estr_emesso.CCPROD, estr_emesso.CCPRODEDIZ, estr_emesso.NCELEM, estr_emesso.QCAUDMED, replace(estr_emesso.PCSHAREA,'.',','), Int([TCDURNET]/60)+([TCDURNET]-(Int([TCDURNET]/60)*60))/100 AS DURNETTA, Int([TCDURLORDA]/60)+([TCDURLORDA]-(Int([TCDURLORDA]/60)*60))/100 AS DURLORDA, estr_emesso.FCPRIMAVIS, estr_emesso.NCPARTE,TIPOL, estr_emesso.CCFASCIA " & _ "FROM estr_emesso INNER JOIN DECOD_TIPOLOGIA ON estr_emesso.FKR0450_CCTIPOL = DECOD_TIPOLOGIA.TIPOL_ESTESA " & _ "WHERE (((DECOD_TIPOLOGIA.SCARICO_DATI)='X'));") 'Elimina record ormai obsoleti (Premium, vecchie reti...) vDb.Execute ("DELETE NEW_ICR_BD_TKBLS010.*, ICR_BD_TKBLS010.CCRETETEL, EMESSO_TYFX0160.ICR_MONDO, ICR_BD_TKBLS010.DCDATGIO " & _ "FROM NEW_ICR_BD_TKBLS010 INNER JOIN EMESSO_TYFX0160 ON NEW_ICR_BD_TKBLS010.CCRETETEL = EMESSO_TYFX0160.CCRETETEL " & _ "WHERE (((EMESSO_TYFX0160.ICR_MONDO) Is Null) AND ((NEW_ICR_BD_TKBLS010.DCDATGIO)<#1/1/2017#)) OR (((NEW_ICR_BD_TKBLS010.CCRETETEL)='MY')) OR (((EMESSO_TYFX0160.ICR_MONDO)='PREMIUM'));") '=============================================================================================================== 'QLIK_TITOLI vDb.Execute ("INSERT INTO NEW_ICR_BD_TR040020 ( FKR0410_CCPROD, XCTIT, CTIPTIT, CCLINGUA ) " & _ "SELECT estr_prod.PRODOTTO, Left([Titolo_Italiano],60) AS Espr3, 'C' AS Espr1, 'I' AS Espr2 " & _ "From estr_prod " & _ "WHERE (((estr_prod.Edizione)='1'));") vDb.Execute ("INSERT INTO NEW_ICR_BD_TR040020 ( FKR0410_CCPROD, XCTIT, CTIPTIT, CCLINGUA ) " & _ "SELECT estr_prod.PRODOTTO, Left([Titolo_originale],60) AS Espr3, 'O' AS Espr1, '' AS Espr2 " & _ "From estr_prod " & _ "WHERE (((estr_prod.Edizione)='1'));") '================================================================================================================ 'QLIK_BOXOFFICE 'nota: gli incassi del 3D vengono accorpati vDb.Execute ("INSERT INTO NEW_ICR_BD_CINEMA ( CD_PROD, DS_STAGIONE, DT_DATA, DS_DISTRIBUTORE, DS_TIPOPROG, NR_SPETTATORI, NR_INCASSO, Sale, Cinema, Citta, Ggprog ) " & _ "SELECT estr_box_totali.Prodotto, estr_box_totali.Stagione, Min(estr_box_totali.Data_debutto) AS MinDiData_debutto, Min(estr_box_totali.Distributore) AS MinDiDistributore, estr_box_totali.Tipo_programmazione, Sum(estr_box_totali.spettatori) AS SommaDispettatori, Sum(estr_box_totali.Incasso) AS SommaDiIncasso, Sum(estr_box_totali.Sale) AS SommaDiSale, Sum(estr_box_totali.Cinema) AS SommaDiCinema, Sum(estr_box_totali.Citta) AS SommaDiCitta, Sum(estr_box_totali.Ggprog) AS SommaDiGgprog " & _ "From estr_box_totali " & _ "Where (((estr_box_totali.Stagione) <> 'stagione')) " & _ "GROUP BY estr_box_totali.Prodotto, estr_box_totali.Stagione, estr_box_totali.Tipo_programmazione;") 'corregge i record "D" doppi mettendo quella in stagioni successive a "Z" vDb.Execute ("SELECT NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_TIPOPROG, Count(NEW_ICR_BD_CINEMA.DS_TIPOPROG) AS ConteggioDiDS_TIPOPROG, Max(NEW_ICR_BD_CINEMA.DS_STAGIONE) AS MaxDiDS_STAGIONE INTO temp " & _ "From NEW_ICR_BD_CINEMA " & _ "GROUP BY NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_TIPOPROG " & _ "HAVING (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D') AND ((Count(NEW_ICR_BD_CINEMA.DS_TIPOPROG))>1));") vDb.Execute ("UPDATE NEW_ICR_BD_CINEMA INNER JOIN temp ON (NEW_ICR_BD_CINEMA.DS_STAGIONE = temp.MaxDiDS_STAGIONE) AND (NEW_ICR_BD_CINEMA.DS_TIPOPROG = temp.DS_TIPOPROG) AND (NEW_ICR_BD_CINEMA.CD_PROD = temp.CD_PROD) SET NEW_ICR_BD_CINEMA.DS_TIPOPROG = 'Z' " & _ "WHERE (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D'));") 'corregge i casi di tipo programmazione doppia nella stessa stagione vDb.Execute ("SELECT NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE, Count(NEW_ICR_BD_CINEMA.DS_STAGIONE) AS ConteggioDiDS_STAGIONE INTO temp " & _ "From NEW_ICR_BD_CINEMA " & _ "GROUP BY NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE " & _ "HAVING (((Count(NEW_ICR_BD_CINEMA.DS_STAGIONE))>1));") vDb.Execute ("SELECT temp.CD_PROD, Sum(NEW_ICR_BD_CINEMA_1.NR_INCASSO) AS SommaDiNR_INCASSO, Sum(NEW_ICR_BD_CINEMA_1.NR_SPETTATORI) AS SommaDiNR_SPETTATORI INTO temp2 " & _ "FROM (temp INNER JOIN NEW_ICR_BD_CINEMA ON (temp.DS_STAGIONE = NEW_ICR_BD_CINEMA.DS_STAGIONE) AND (temp.CD_PROD = NEW_ICR_BD_CINEMA.CD_PROD)) INNER JOIN NEW_ICR_BD_CINEMA AS NEW_ICR_BD_CINEMA_1 ON (temp.DS_STAGIONE = NEW_ICR_BD_CINEMA_1.DS_STAGIONE) AND (temp.CD_PROD = NEW_ICR_BD_CINEMA_1.CD_PROD) " & _ "Where (((NEW_ICR_BD_CINEMA.DS_TIPOPROG) = 'D') And ((NEW_ICR_BD_CINEMA_1.DS_TIPOPROG) <> 'D')) " & _ "GROUP BY temp.CD_PROD;") vDb.Execute ("UPDATE NEW_ICR_BD_CINEMA INNER JOIN temp2 ON NEW_ICR_BD_CINEMA.CD_PROD = temp2.CD_PROD SET NEW_ICR_BD_CINEMA.NR_INCASSO = [NR_INCASSO]+[SommaDiNR_INCASSO], NEW_ICR_BD_CINEMA.NR_SPETTATORI = [NR_SPETTATORI]+[SommaDiNR_SPETTATORI] " & _ "WHERE (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D'));") vDb.Execute ("DELETE DISTINCTROW NEW_ICR_BD_CINEMA.DS_TIPOPROG, NEW_ICR_BD_CINEMA_1.*, NEW_ICR_BD_CINEMA_1.DS_TIPOPROG " & _ "FROM NEW_ICR_BD_CINEMA INNER JOIN NEW_ICR_BD_CINEMA AS NEW_ICR_BD_CINEMA_1 ON (NEW_ICR_BD_CINEMA.DS_STAGIONE = NEW_ICR_BD_CINEMA_1.DS_STAGIONE) AND (NEW_ICR_BD_CINEMA.CD_PROD = NEW_ICR_BD_CINEMA_1.CD_PROD) " & _ "WHERE (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D') AND ((NEW_ICR_BD_CINEMA_1.DS_TIPOPROG)<>'D'));") vDb.Execute ("SELECT NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE, Count(NEW_ICR_BD_CINEMA.DS_STAGIONE) AS ConteggioDiDS_STAGIONE INTO temp " & _ "From NEW_ICR_BD_CINEMA " & _ "GROUP BY NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE " & _ "HAVING (((Count(NEW_ICR_BD_CINEMA.DS_STAGIONE))>1));") vDb.Execute ("SELECT NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE, Min(NEW_ICR_BD_CINEMA.DT_DATA) AS MinDiDT_DATA, Min(NEW_ICR_BD_CINEMA.DS_DISTRIBUTORE) AS MinDiDS_DISTRIBUTORE, Sum(NEW_ICR_BD_CINEMA.NR_SPETTATORI) AS SommaDiNR_SPETTATORI, Sum(NEW_ICR_BD_CINEMA.NR_INCASSO) AS SommaDiNR_INCASSO, 'P' AS DS_TIPOPROG, Sum(NEW_ICR_BD_CINEMA.SALE) AS SommaDiSALE, Sum(NEW_ICR_BD_CINEMA.CINEMA) AS SommaDiCINEMA, Sum(NEW_ICR_BD_CINEMA.CITTA) AS SommaDiCITTA, Sum(NEW_ICR_BD_CINEMA.GGPROG) AS SommaDiGGPROG INTO temp2 " & _ "FROM temp INNER JOIN NEW_ICR_BD_CINEMA ON (temp.CD_PROD = NEW_ICR_BD_CINEMA.CD_PROD) AND (temp.DS_STAGIONE = NEW_ICR_BD_CINEMA.DS_STAGIONE) " & _ "GROUP BY NEW_ICR_BD_CINEMA.CD_PROD, NEW_ICR_BD_CINEMA.DS_STAGIONE, 'P';") vDb.Execute ("DELETE DISTINCTROW NEW_ICR_BD_CINEMA.* " & _ "FROM temp INNER JOIN NEW_ICR_BD_CINEMA ON (temp.DS_STAGIONE = NEW_ICR_BD_CINEMA.DS_STAGIONE) AND (temp.CD_PROD = NEW_ICR_BD_CINEMA.CD_PROD);") vDb.Execute ("INSERT INTO NEW_ICR_BD_CINEMA ( CD_PROD, DS_STAGIONE, DT_DATA, DS_DISTRIBUTORE, NR_SPETTATORI, NR_INCASSO, DS_TIPOPROG, SALE, CINEMA, CITTA, GGPROG ) " & _ "SELECT temp2.CD_PROD, temp2.DS_STAGIONE, temp2.MinDiDT_DATA, temp2.MinDiDS_DISTRIBUTORE, temp2.SommaDiNR_SPETTATORI, temp2.SommaDiNR_INCASSO, temp2.DS_TIPOPROG, temp2.SommaDiSALE, temp2.SommaDiCINEMA, temp2.SommaDiCITTA, temp2.SommaDiGGPROG " & _ "FROM temp2;") 'i proseguimenti non nella stagione successiva al debutto vengono ribatezzati come "R" (riproposizione) vDb.Execute ("UPDATE NEW_ICR_BD_CINEMA INNER JOIN NEW_ICR_BD_CINEMA AS NEW_ICR_BD_CINEMA_1 ON NEW_ICR_BD_CINEMA.CD_PROD = NEW_ICR_BD_CINEMA_1.CD_PROD SET NEW_ICR_BD_CINEMA_1.DS_TIPOPROG = 'R' " & _ "WHERE (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D') AND ((NEW_ICR_BD_CINEMA_1.DT_DATA)>[NEW_ICR_BD_CINEMA]![DT_DATA]+365) AND ((NEW_ICR_BD_CINEMA_1.DS_TIPOPROG)='P') AND ((Val(Left([NEW_ICR_BD_CINEMA_1]![DS_STAGIONE],4)))<>Val(Left([NEW_ICR_BD_CINEMA]![DS_STAGIONE],4))+1));") 'vengono accorpati gli incassi D+P vDb.Execute ("SELECT NEW_ICR_BD_CINEMA.CD_PROD, Sum(NEW_ICR_BD_CINEMA.NR_INCASSO) AS SommaDiNR_INCASSO, Sum(NEW_ICR_BD_CINEMA.NR_SPETTATORI) AS SommaDiNR_SPETTATORI INTO temp " & _ "From NEW_ICR_BD_CINEMA " & _ "Where (((NEW_ICR_BD_CINEMA.DS_TIPOPROG) = 'P'))" & _ "GROUP BY NEW_ICR_BD_CINEMA.CD_PROD;") vDb.Execute ("UPDATE temp INNER JOIN NEW_ICR_BD_CINEMA ON temp.CD_PROD = NEW_ICR_BD_CINEMA.CD_PROD SET NEW_ICR_BD_CINEMA.NR_SPETTATORI = [NR_SPETTATORI]+[SommaDiNR_SPETTATORI], NEW_ICR_BD_CINEMA.NR_INCASSO = [NR_INCASSO]+[SommaDiNR_INCASSO] " & _ "WHERE (((NEW_ICR_BD_CINEMA.DS_TIPOPROG)='D'));") '=========================================================================================== 'versione "like ICR": vengono tolti i dati in eccesso 'elimina da QLIK il tipo programmazione diversi da D (non presenti in ICR) vDb.Execute ("DELETE NEW_ICR_BD_CINEMA.*, NEW_ICR_BD_CINEMA.DS_TIPOPROG From NEW_ICR_BD_CINEMA WHERE (((DS_TIPOPROG)<>'D'));") '============================================================================================== 'IMDB vDb.Execute ("INSERT INTO NEW_QLIK_IMDB (RIFER, RIFERIMENTO_IMDB) " & _ "SELECT estr_imdb.RIFER, estr_imdb.RIFERIMENTO_IMDB " & _ "FROM estr_imdb " & _ "WHERE (((estr_imdb.RIFERIMENTO_IMDB) Like 'tt*'));") 'SCELTE DI RETE 'controlla che non si siano aggiunte delle Reti non gestite Set rs = vDb.OpenRecordset("SELECT estr_scelte_rete.RETE " & _ "FROM estr_scelte_rete " & _ "WHERE (((Left([STAGIONE], 4)) = Format(Date (), 'yyyy'))) Or (((Left([STAGIONE], 4)) = Format(Date (), 'yyyy') - 1)) " & _ "GROUP BY estr_scelte_rete.RETE " & _ "HAVING (((estr_scelte_rete.RETE)<>'None')) OR (((estr_scelte_rete.RETE)<>'None'));") rs.MoveLast If rs.RecordCount > 12 Then MsgBox ("ALT: ci sono delle Reti non gestite") End If vDb.Execute ("INSERT INTO NEW_QLIK_SCELTE_RETE ( TIPOLOGIA, RIFER, STAGIONE ) SELECT estr_scelte_rete.TIPOLOGIA, estr_scelte_rete.RIFER, estr_scelte_rete.STAGIONE " & _ "From estr_scelte_rete " & _ "WHERE STAGIONE =IIf(Date()>CVDate('10/09/' & Format(Date(),'yyyy')),Format(Date(),'yyyy') & '/' & Format(Date(),'yyyy')+1,Format(Date(),'yyyy')-1 & '/' & Format(Date(),'yyyy')) " & _ "GROUP BY estr_scelte_rete.TIPOLOGIA, estr_scelte_rete.RIFER, estr_scelte_rete.STAGIONE") For n = 1 To 12 If n = 1 Then varReteEstesa = "CANALE 5" varReteBreve = "C5" ElseIf n = 2 Then varReteEstesa = "ITALIA 1" varReteBreve = "I1" ElseIf n = 3 Then varReteEstesa = "RETEQUATTRO" varReteBreve = "R4" ElseIf n = 4 Then varReteEstesa = "IRIS" varReteBreve = "KI" ElseIf n = 5 Then varReteEstesa = "LA 5" varReteBreve = "KA" ElseIf n = 6 Then varReteEstesa = "ITALIA 2" varReteBreve = "I2" ElseIf n = 7 Then varReteEstesa = "MEDIASET EXTRA" varReteBreve = "KQ" ElseIf n = 8 Then varReteEstesa = "TOP CRIME" varReteBreve = "LT" ElseIf n = 9 Then varReteEstesa = "20" varReteBreve = "20" ElseIf n = 10 Then varReteEstesa = "FOCUS" varReteBreve = "FO" ElseIf n = 11 Then varReteEstesa = "CINE34" varReteBreve = "B6" ElseIf n = 12 Then varReteEstesa = "TWENTYSEVEN" varReteBreve = "TS" End If vDb.Execute ("SELECT DISTINCTROW RIFER, TIPOLOGIA, STAGIONE, RETE, SLOT INTO temp " & _ "From estr_scelte_rete " & _ "WHERE (((RETE)='" & varReteEstesa & "'));") vDb.Execute ("UPDATE temp INNER JOIN QLIK_DECOD_SCELTE_RETE_SLOT ON temp.SLOT = QLIK_DECOD_SCELTE_RETE_SLOT.SLOT SET temp.SLOT = [SLOT_BREVE];") vDb.Execute ("UPDATE NEW_QLIK_SCELTE_RETE INNER JOIN temp ON (NEW_QLIK_SCELTE_RETE.STAGIONE = temp.STAGIONE) AND (NEW_QLIK_SCELTE_RETE.TIPOLOGIA = temp.TIPOLOGIA) AND (NEW_QLIK_SCELTE_RETE.RIFER = temp.RIFER) SET NEW_QLIK_SCELTE_RETE." & varReteBreve & " = [SLOT];") vDb.Execute ("UPDATE NEW_QLIK_SCELTE_RETE INNER JOIN temp ON (NEW_QLIK_SCELTE_RETE.STAGIONE = temp.STAGIONE) AND (NEW_QLIK_SCELTE_RETE.TIPOLOGIA = temp.TIPOLOGIA) AND (NEW_QLIK_SCELTE_RETE.RIFER = temp.RIFER) SET NEW_QLIK_SCELTE_RETE." & varReteBreve & " = [" & varReteBreve & "] & ',' & [SLOT] " & _ "WHERE (((NEW_QLIK_SCELTE_RETE.[" & varReteBreve & "])<>[SLOT]));") Next n vDb.Execute ("UPDATE NEW_QLIK_SCELTE_RETE SET NEW_QLIK_SCELTE_RETE.SCELTE_RETE_SINTESI = Mid(IIf([C5]is not null ,', C5 ' & [C5]) & IIf([I1]is not null,', I1 ' & [I1]) & IIf([R4]is not null,', R4 ' & [R4]) & IIf([KI]is not null,', IR ' & [KI]) & IIf([KA]is not null,', L5 ' & [KA]) & IIf([I2]is not null,', I2 ' & [I2]) & IIf([KQ]is not null,', EX ' & [KQ]) & IIf([LT]is not null,', TC ' & [LT]) & IIf([20]is not null,', 20 ' & [20])& IIf([FO]is not null,', FO ' & [FO])& IIf([B6]is not null,', C34 ' & [B6]) & IIf([TS]is not null,', C27 ' & [TS]),3);") vDb.Execute ("UPDATE NEW_QLIK_SCELTE_RETE INNER JOIN DECOD_TIPOLOGIA ON NEW_QLIK_SCELTE_RETE.TIPOLOGIA = DECOD_TIPOLOGIA.TIPOL_ESTESA SET NEW_QLIK_SCELTE_RETE.TIPOLOGIA = [DECOD_TIPOLOGIA]![TIPOL];") 'estr_cast vDb.Execute ("INSERT INTO NEW_QLIK_CAST ( CCPRODTIP, CCPROD, RUOLO, DESCR_RUOLO, PROGR_RUOLO, PROGR_CAST, NOME, COGNOME )" & _ "SELECT estr_cast.Campo1, estr_cast.Campo2, estr_cast.Campo3, estr_cast.Campo4, estr_cast.Campo5, estr_cast.Campo6, estr_cast.Campo7, estr_cast.Campo8 " & _ "From estr_cast " & _ "WHERE (((estr_cast.Campo1)='F'));") 'estr_veg vDb.Execute ("INSERT INTO NEW_ICR_BD_TR040440 ( FK_R040050_CCPRODTIP, FK_R040050_CCPROD, FK_R040050_CCPRODEDIZ, CCVALGEST, DESCR_VEG, NCPROGR, DDATINIVALID, DDATFINVALID, VEG_TENTATIVE, START_DATE_TENTATIVE ) " & _ "SELECT estr_veg.CCPRODTIP, estr_veg.CCPROD, estr_veg.CCPRODEDIZ, estr_veg.CCVALGEST, estr_veg.DESCR_VEG,estr_veg.NCPROGR, estr_veg.DDATINIVALID, estr_veg.DDATFINVALID, estr_veg.VEG_TENTATIVE, estr_veg.START_DATE_TENTATIVE " & _ "From estr_veg " & _ "WHERE (((estr_veg.CCPRODTIP)='F'));") '============================================================================================================================= 'estr_acq vDb.Execute ("INSERT INTO NEW_ICR_DIRITTI_X_ICR ( ID, TIPOLOGIA, PROD, EDIZ, D_T, RAGSOC_DISTR, PERC, PASS_CONS, PASS_CONS_TOT, PASS_EFF, PASS_EFF_TOT, REPL_CONS, ORE_REPL, TIPO_DIRITTO, PIATTAFORMA, DECR, SCAD, CAUSALE, FLAG_INIB, DECR_INIB, SCAD_INIB, SIMULCAST, CONDIVISIONE, CONVERSIONE, TIPO_CONV, RETE_CONV, NUM_EMI_CONV, NUM_ORE_CONV, NUM_MESI_CONV, NUM_REPL_CONV, NUM_ORE_REPL_CONV, RETE_CONV2, NUM_EMI_CONV_2, NUM_ORE_CONV_2, NUM_MESI_CONV_2, NUM_REPL_CONV_2, NUM_ORE_REPL_CONV_2, MAX_PASS_CONV, MAX_EMISS_PT, CON_AUTORIZ, DATA_AUTORIZ, CON_NOTIFICA, NOTE_CONV, DATA_VENDITA, NOTE_PASSAGGI, NOTE_PIATTAFORMA, RESTRIZIONE_PIATTAFORMA, CATCH_UP_RIGHTS, CATCH_UP_PERIOD, CATCH_UP_NOTE, FR_RR, CONTRAENTE_WIN_1, DECR_WIN_1, SCAD_WIN_1, CAUSALE_WIN_1, CAUSALE_INIBIZIONE_WIN_1, NOTE_WIN_1, CONTRAENTE_WIN_2, DECR_WIN_2, SCAD_WIN_2, CAUSALE_WIN_2, CAUSALE_INIBIZIONE_WIN_2, NOTE_WIN_2, CONTRAENTE_WIN_3, DECR_WIN_3, SCAD_WIN_3, CAUSALE_WIN_3, CAUSALE_INIBIZIONE_WIN_3, NOTE_WIN_3, CONTRAENTE_WIN_4, " & _ "DECR_WIN_4, SCAD_WIN_4, CAUSALE_WIN_4, CAUSALE_INIBIZIONE_WIN_4, NOTE_WIN_4, CONTRAENTE_WIN_5, DECR_WIN_5, SCAD_WIN_5, CAUSALE_WIN_5, CAUSALE_INIBIZIONE_WIN_5, NOTE_WIN_5, CONTRAENTE_WIN_6, DECR_WIN_6, SCAD_WIN_6, CAUSALE_WIN_6, CAUSALE_INIBIZIONE_WIN_6, NOTE_WIN_6, CONTRAENTE_WIN_7, DECR_WIN_7, SCAD_WIN_7, CAUSALE_WIN_7, CAUSALE_INIBIZIONE_WIN_7, NOTE_WIN_7, CONTRAENTE_WIN_8, DECR_WIN_8, SCAD_WIN_8, CAUSALE_WIN_8, CAUSALE_INIBIZIONE_WIN_8, NOTE_WIN_8, CONTRAENTE_WIN_9, DECR_WIN_9, SCAD_WIN_9, CAUSALE_WIN_9, CAUSALE_INIBIZIONE_WIN_9, NOTE_WIN_9, CONTRAENTE, STRU, CONTRATTO, RIGA, SITUAZIONE ) " & _ "SELECT D.ID, D.TIPOLOGIA, D.PROD, D.EDIZ, D.D_T, D.RAGSOC_DISTR, D.PERC, Val([PASS_CONS]) AS Espr1, Val([PASS_CONS_TOT]) AS Espr2, Val([PASS_EFF]) AS Espr3, Val([PASS_EFF_TOT]) AS Espr4, D.REPL_CONS, D.ORE_REPL, D.TIPO_DIRITTO, D.PIATTAFORMA, D.DECR, D.SCAD, Val([CAUSALE]) AS Espr5, D.FLAG_INIB, D.DECR_INIB, D.SCAD_INIB, D.SIMULCAST, D.CONDIVISIONE, D.CONVERSIONE, D.TIPO_CONV, D.RETE_CONV, D.NUM_EMI_CONV, D.NUM_ORE_CONV, D.NUM_MESI_CONV, D.NUM_REPL_CONV, D.NUM_ORE_REPL_CONV, D.RETE_CONV2, D.NUM_EMI_CONV_2, D.NUM_ORE_CONV_2, D.NUM_MESI_CONV_2, D.NUM_REPL_CONV_2, D.NUM_ORE_REPL_CONV_2, D.MAX_PASS_CONV, D.MAX_EMISS_PT, D.CON_AUTORIZ, D.DATA_AUTORIZ, D.CON_NOTIFICA, D.NOTE_CONV, D.DATA_VENDITA, D.NOTE_PASSAGGI, D.NOTE_PIATTAFORMA, D.RESTRIZIONE_PIATTAFORMA, D.CATCH_UP_RIGHTS, D.CATCH_UP_PERIOD, D.CATCH_UP_NOTE, D.FR_RR, D.CONTRAENTE_WIN_1, D.DECR_WIN_1, D.SCAD_WIN_1, D.CAUSALE_WIN_1, D.CAUSALE_INIBIZIONE_WIN_1, D.NOTE_WIN_1, D.CONTRAENTE_WIN_2, D.DECR_WIN_2, D.SCAD_WIN_2, D.CAUSALE_WIN_2, " & _ "D.CAUSALE_INIBIZIONE_WIN_2 , D.NOTE_WIN_2, D.CONTRAENTE_WIN_3, D.DECR_WIN_3, D.SCAD_WIN_3, D.CAUSALE_WIN_3, D.CAUSALE_INIBIZIONE_WIN_3, D.NOTE_WIN_3, D.CONTRAENTE_WIN_4, D.DECR_WIN_4, D.SCAD_WIN_4, D.CAUSALE_WIN_4, D.CAUSALE_INIBIZIONE_WIN_4, D.NOTE_WIN_4, D.CONTRAENTE_WIN_5, D.DECR_WIN_5, D.SCAD_WIN_5, D.CAUSALE_WIN_5, D.CAUSALE_INIBIZIONE_WIN_5, D.NOTE_WIN_5, D.CONTRAENTE_WIN_6, D.DECR_WIN_6, D.SCAD_WIN_6, D.CAUSALE_WIN_6, D.CAUSALE_INIBIZIONE_WIN_6, D.NOTE_WIN_6, D.CONTRAENTE_WIN_7, D.DECR_WIN_7, D.SCAD_WIN_7, D.CAUSALE_WIN_7, D.CAUSALE_INIBIZIONE_WIN_7, D.NOTE_WIN_7, D.CONTRAENTE_WIN_8, D.DECR_WIN_8, D.SCAD_WIN_8, D.CAUSALE_WIN_8, D.CAUSALE_INIBIZIONE_WIN_8, D.NOTE_WIN_8, D.CONTRAENTE_WIN_9, D.DECR_WIN_9, D.SCAD_WIN_9, D.CAUSALE_WIN_9, D.CAUSALE_INIBIZIONE_WIN_9, D.NOTE_WIN_9, D.CONTRAENTE, D.STRU, D.CONTRATTO, D.RIGA, D.SITUAZIONE " & _ "FROM estr_acq AS D " & _ "WHERE (((D.TIPOLOGIA) Is Not Null));") 'sistema gli indefiniti vDb.Execute ("SELECT Val([estr_acq]![ID]) AS ID, IIf([DECR]='01/01/0001','01/01/1001',[DECR]) AS NEW_DECR, IIf([SCAD]='01/01/0001','01/01/1001',[SCAD]) AS NEW_SCAD INTO temp " & _ "From estr_acq " & _ "WHERE (((estr_acq.DECR)='01/01/0001')) OR (((estr_acq.SCAD)='01/01/0001'));") vDb.Execute ("UPDATE temp INNER JOIN NEW_ICR_DIRITTI_X_ICR ON temp.ID = NEW_ICR_DIRITTI_X_ICR.ID SET NEW_ICR_DIRITTI_X_ICR.DECR = [NEW_DECR], NEW_ICR_DIRITTI_X_ICR.SCAD = [NEW_SCAD];") '================================================================================================================================ vDb.Close 'esporta le tabelle sul db SNAPSHOT Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "EMESSO_TYFX0160", acTable, "EMESSO_TYFX0160" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_CINEMA", acTable, "NEW_ICR_BD_CINEMA" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TKBLS010", acTable, "NEW_ICR_BD_TKBLS010" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TR040020", acTable, "NEW_ICR_BD_TR040020" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TR040050", acTable, "NEW_ICR_BD_TR040050" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TR040440", acTable, "NEW_ICR_BD_TR040440" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TR990100", acTable, "ICR_BD_TR990100" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_BD_TR990270", acTable, "ICR_BD_TR990270" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "ICR_DIRITTI_X_ICR", acTable, "NEW_ICR_DIRITTI_X_ICR" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "QLIK_CAST", acTable, "NEW_QLIK_CAST" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "QLIK_IMDB", acTable, "NEW_QLIK_IMDB" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "QLIK_SCELTE_RETE", acTable, "NEW_QLIK_SCELTE_RETE" MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "QLIK_SUPERSERIE", acTable, "NEW_QLIK_SUPERSERIE" MsAxs.CloseCurrentDatabase FileCopy ThisWorkbook.path & "\temp_db\SNAPSHOT.accdb", "\\mediaset.it\share\Indirizzo_Controllo_Risorse\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker\SNAPSHOT.accdb" Application.DisplayAlerts = True Call sUpdater("End", "SNAPSHOT") Exit Sub errore: If Err.Number = 3010 Then vDb.Execute ("drop table " & Replace(Mid(Err.Description, 10), "' già esistente.", "")) Resume ElseIf Err.Number = 53 Then 'MsgBox Err.Description Resume Next Else MsgBox (Err.Description) Resume End End If End Sub Public Sub sub_UPDATE_CUSTOM_ANAGRAFICA() On Error GoTo errore: Call sUpdater("Start", "CUSTOM_ANAGRAFICA") 'anagrafica in orizzontale NEW_CUSTOM_ANAGR_ORIZ========================================== vDb.Execute ("INSERT INTO NEW_CUSTOM_ANAGR_ORIZ ( TIPOL, EPIS, RIFER, ANNO, DUR, VEG, GENERE1, GENERE2, PAESE ) " & _ "SELECT ICR_BD_TR040050.FKR0490_CCTIPOL, ICR_BD_TR040050.CCNUMELEM, ICR_BD_TR040050.FKR0410_CCPROD, ICR_BD_TR040050.CCAAPRODZ, ICR_BD_TR040050.TCDURATANOM, ICR_BD_TR990270.DVEG, ICR_BD_TR990100.XCGENERE, ICR_BD_TR990100_1.XCGENERE, ICR_BD_TR040050.PAESE1 " & _ "FROM ((ICR_BD_TR040050 LEFT JOIN ICR_BD_TR990270 ON ICR_BD_TR040050.CCVALGEST = ICR_BD_TR990270.CCVALGEST) LEFT JOIN ICR_BD_TR990100 ON ICR_BD_TR040050.CCGENERE1 = ICR_BD_TR990100.CCGENERE) LEFT JOIN ICR_BD_TR990100 AS ICR_BD_TR990100_1 ON ICR_BD_TR040050.CCGENERE2 = ICR_BD_TR990100_1.CCGENERE " & _ "WHERE (((ICR_BD_TR040050.FKR0490_CCTIPOL)='A' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='E' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='F' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='G' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='M' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='O' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='T' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='Z' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='7' Or (ICR_BD_TR040050.FKR0490_CCTIPOL)='D') AND ((ICR_BD_TR040050.CCPRODEDIZ)=1));") vDb.Execute ("UPDATE NEW_CUSTOM_ANAGR_ORIZ INNER JOIN ICR_BD_TR040020 ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = ICR_BD_TR040020.FKR0410_CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.TI = [XCTIT] " & _ "WHERE (((ICR_BD_TR040020.CTIPTIT)='C') AND ((ICR_BD_TR040020.CCLINGUA)='I'));") vDb.Execute ("UPDATE NEW_CUSTOM_ANAGR_ORIZ INNER JOIN ICR_BD_TR040020 ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = ICR_BD_TR040020.FKR0410_CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.[TO] = [XCTIT] " & _ "WHERE (((ICR_BD_TR040020.CTIPTIT)='O'));") 'REGISTA vDb.Execute "SELECT QLIK_CAST.CCPROD, Min(QLIK_CAST.PROGR_CAST) AS MinDiPROGR_CAST INTO temp " & _ "From QLIK_CAST " & _ "Where (((QLIK_CAST.RUOLO) = 'FRE')) " & _ "GROUP BY QLIK_CAST.CCPROD;" vDb.Execute ("UPDATE NEW_CUSTOM_ANAGR_ORIZ INNER JOIN (temp INNER JOIN QLIK_CAST ON (temp.CCPROD = QLIK_CAST.CCPROD) AND (temp.MinDiPROGR_CAST = QLIK_CAST.PROGR_CAST)) ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = temp.CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.REGISTA_NOME = [NOME], NEW_CUSTOM_ANAGR_ORIZ.REGISTA_COGN = [COGNOME]" & _ "WHERE (((QLIK_CAST.RUOLO)='FRE'));") 'ATTORI vDb.Execute ("SELECT QLIK_CAST.CCPROD, Min(QLIK_CAST.PROGR_CAST) AS 1, Min(0) AS 2, Min(0) AS 3 INTO temp " & _ "FROM NEW_CUSTOM_ANAGR_ORIZ INNER JOIN QLIK_CAST ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = QLIK_CAST.CCPROD " & _ "Where (((QLIK_CAST.RUOLO) = 'C001')) " & _ "GROUP BY QLIK_CAST.CCPROD;") vDb.Execute ("SELECT QLIK_CAST.CCPROD, Min(QLIK_CAST.PROGR_CAST) AS MinDiPROGR_CAST INTO temp2 " & _ "FROM QLIK_CAST INNER JOIN temp ON QLIK_CAST.CCPROD = temp.CCPROD " & _ "Where (((QLIK_CAST.RUOLO) = 'C001') And ((QLIK_CAST.PROGR_CAST) > [1])) " & _ "GROUP BY QLIK_CAST.CCPROD;") vDb.Execute ("UPDATE temp INNER JOIN temp2 ON temp.CCPROD = temp2.CCPROD SET temp.[2] = [MinDiPROGR_CAST];") vDb.Execute ("SELECT QLIK_CAST.CCPROD, Min(QLIK_CAST.PROGR_CAST) AS MinDiPROGR_CAST INTO temp2 " & _ "FROM QLIK_CAST INNER JOIN temp ON QLIK_CAST.CCPROD = temp.CCPROD " & _ "Where (((QLIK_CAST.RUOLO) = 'C001') And ((QLIK_CAST.PROGR_CAST) > [2])) " & _ "GROUP BY QLIK_CAST.CCPROD;") vDb.Execute ("UPDATE temp INNER JOIN temp2 ON temp.CCPROD = temp2.CCPROD SET temp.[3] = [MinDiPROGR_CAST];") vDb.Execute ("UPDATE (NEW_CUSTOM_ANAGR_ORIZ INNER JOIN temp ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = temp.CCPROD) INNER JOIN QLIK_CAST ON temp.CCPROD = QLIK_CAST.CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.ATTORE1 = [NOME] & ' ' & [COGNOME] " & _ "WHERE (((QLIK_CAST.RUOLO)='C001') AND ((QLIK_CAST.PROGR_CAST)=[1]));") vDb.Execute ("UPDATE (NEW_CUSTOM_ANAGR_ORIZ INNER JOIN temp ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = temp.CCPROD) INNER JOIN QLIK_CAST ON temp.CCPROD = QLIK_CAST.CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.ATTORE2 = [NOME] & ' ' & [COGNOME] " & _ "WHERE (((QLIK_CAST.RUOLO)='C001') AND ((QLIK_CAST.PROGR_CAST)=[2]));") vDb.Execute ("UPDATE (NEW_CUSTOM_ANAGR_ORIZ INNER JOIN temp ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = temp.CCPROD) INNER JOIN QLIK_CAST ON temp.CCPROD = QLIK_CAST.CCPROD SET NEW_CUSTOM_ANAGR_ORIZ.ATTORE3 = [NOME] & ' ' & [COGNOME] " & _ "WHERE (((QLIK_CAST.RUOLO)='C001') AND ((QLIK_CAST.PROGR_CAST)=[3]));") 'boxoffice vDb.Execute ("UPDATE NEW_CUSTOM_ANAGR_ORIZ INNER JOIN ICR_BD_CINEMA ON NEW_CUSTOM_ANAGR_ORIZ.RIFER = ICR_BD_CINEMA.CD_PROD SET NEW_CUSTOM_ANAGR_ORIZ.BOX_DATA = [DT_DATA], NEW_CUSTOM_ANAGR_ORIZ.BOX_INCASSO = [NR_INCASSO], NEW_CUSTOM_ANAGR_ORIZ.BOX_SPETTATORI = [NR_SPETTATORI], NEW_CUSTOM_ANAGR_ORIZ.BOX_DISTRIBUTORE = [DS_DISTRIBUTORE] " & _ "WHERE ICR_BD_CINEMA.DS_TIPOPROG ='D';") 'diritti 'free vDb.Execute ("UPDATE ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER SET NEW_CUSTOM_ANAGR_ORIZ.DF_ICR_FLAG = IIf([flag_inib]='S','I'), NEW_CUSTOM_ANAGR_ORIZ.DF_DECR = [DECR], NEW_CUSTOM_ANAGR_ORIZ.DF_SCAD = [SCAD],NEW_CUSTOM_ANAGR_ORIZ.DF_FR_RR = [FR_RR], NEW_CUSTOM_ANAGR_ORIZ.DF_RAGSOC_DISTR = [RAGSOC_DISTR], NEW_CUSTOM_ANAGR_ORIZ.DF_PERC = [PERC], NEW_CUSTOM_ANAGR_ORIZ.DF_PASS_CONS_TOT = [PASS_CONS_TOT], NEW_CUSTOM_ANAGR_ORIZ.DF_PASS_EFF_TOT = [PASS_EFF_TOT], NEW_CUSTOM_ANAGR_ORIZ.DF_CAUSALE = [CAUSALE], NEW_CUSTOM_ANAGR_ORIZ.DF_DECR_WIN_1 = [DECR_WIN_1], NEW_CUSTOM_ANAGR_ORIZ.DF_SCAD_WIN_1 = [SCAD_WIN_1], NEW_CUSTOM_ANAGR_ORIZ.DF_DECR_WIN_2 = [DECR_WIN_2], NEW_CUSTOM_ANAGR_ORIZ.DF_SCAD_WIN_2 = [SCAD_WIN_2], NEW_CUSTOM_ANAGR_ORIZ.DF_WIN_ALTRE = IIf([DECR_WIN_3] Is Not Null,'W',Null) " & _ "WHERE (((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico'));") 'free -->diritti futuri. Sovrascrive il distributore futuro nella colonna del distributore in essere vDb.Execute ("SELECT ICR_DIRITTI_X_ICR.PROD, Min(ICR_DIRITTI_X_ICR.DECR) AS MinDiDECR INTO temp " & _ "FROM ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER " & _ "WHERE (((ICR_DIRITTI_X_ICR.DECR)>Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) " & _ "GROUP BY ICR_DIRITTI_X_ICR.PROD;") vDb.Execute ("UPDATE (ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER) INNER JOIN temp ON (ICR_DIRITTI_X_ICR.DECR = temp.MinDiDECR) AND (ICR_DIRITTI_X_ICR.PROD = temp.PROD) SET NEW_CUSTOM_ANAGR_ORIZ.DF_FUT_FR_RR = [FR_RR],NEW_CUSTOM_ANAGR_ORIZ.DF_RAGSOC_DISTR = [RAGSOC_DISTR], NEW_CUSTOM_ANAGR_ORIZ.DF_FUT_DECR = [DECR], NEW_CUSTOM_ANAGR_ORIZ.DF_FUT_SCAD = [SCAD] " & _ "WHERE (((ICR_DIRITTI_X_ICR.DECR)>Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico'));") 'flag più righe di diritto in essere vDb.Execute ("UPDATE ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER SET NEW_CUSTOM_ANAGR_ORIZ.DF_ICR_FLAG = [DF_ICR_FLAG] & '+' " & _ "WHERE (((NEW_CUSTOM_ANAGR_ORIZ.DF_DECR)<>[DECR]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_SCAD)<>[SCAD]) " & _ "AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_RAGSOC_DISTR)<>[RAGSOC_DISTR]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_PERC)<>[PERC]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_PASS_CONS_TOT)<>[PASS_CONS_TOT]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date() " & _ ") AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_PASS_EFF_TOT)<>[PASS_EFF_TOT]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico')) OR (((NEW_CUSTOM_ANAGR_ORIZ.DF_CAUSALE)<>[CAUSALE]) AND ((ICR_DIRITTI_X_ICR.DECR)<=Date()) AND ((ICR_DIRITTI_X_ICR.SCAD)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='free') AND ((ICR_DIRITTI_X_ICR.PIATTAFORMA)='analogico'));") 'free -->scaduti vDb.Execute ("SELECT ICR_DIRITTI_X_ICR.PROD, Max(ICR_DIRITTI_X_ICR.SCAD) AS MaxDiSCAD INTO temp " & _ "FROM ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER " & _ "WHERE (((NEW_CUSTOM_ANAGR_ORIZ.DF_SCAD) Is Null) AND ((ICR_DIRITTI_X_ICR.DECR)=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='TVOD'));") 'futuro vDb.Execute ("UPDATE ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER SET NEW_CUSTOM_ANAGR_ORIZ.DTVOD_DECR = [DECR], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_SCAD = [SCAD], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_FR_RR = [FR_RR], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_RAGSOC_DISTR = [RAGSOC_DISTR] " & _ "WHERE (((NEW_CUSTOM_ANAGR_ORIZ.DTVOD_DECR) Is Null) AND ((ICR_DIRITTI_X_ICR.DECR)>=Date()) AND ((ICR_DIRITTI_X_ICR.TIPO_DIRITTO)='TVOD'));") 'scaduto vDb.Execute ("UPDATE ICR_DIRITTI_X_ICR INNER JOIN NEW_CUSTOM_ANAGR_ORIZ ON ICR_DIRITTI_X_ICR.PROD = NEW_CUSTOM_ANAGR_ORIZ.RIFER SET NEW_CUSTOM_ANAGR_ORIZ.DTVOD_DECR = [DECR], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_SCAD = [SCAD], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_FR_RR = [FR_RR], NEW_CUSTOM_ANAGR_ORIZ.DTVOD_RAGSOC_DISTR = [RAGSOC_DISTR] " & _ "WHERE (((NEW_CUSTOM_ANAGR_ORIZ.DTVOD_DECR) Is Null) AND ((ICR_DIRITTI_X_ICR.SCAD)=#1/8/2010#) AND ((NEW_BOXOFFICE.rifer) Is Null));") 'aggiorna dati anagrafici 'vDb.Execute ("UPDATE NEW_BOXOFFICE INNER JOIN CUSTOM_ANAGR_ORIZ ON NEW_BOXOFFICE.rifer = CUSTOM_ANAGR_ORIZ.RIFER SET NEW_BOXOFFICE.TI = [CUSTOM_ANAGR_ORIZ]![TI], NEW_BOXOFFICE.[TO] = [CUSTOM_ANAGR_ORIZ]![TO], NEW_BOXOFFICE.ANNO = [CUSTOM_ANAGR_ORIZ]![ANNO], NEW_BOXOFFICE.PAESE = [CUSTOM_ANAGR_ORIZ]![PAESE], NEW_BOXOFFICE.GENERE = [GENERE1] & ' ' & [GENERE2], NEW_BOXOFFICE.REGIA = [REGISTA_NOME] & ' ' & [REGISTA_COGN], NEW_BOXOFFICE.[CAST] = [ATTORE1] & ' ' & [ATTORE2] & ' ' & [ATTORE3], NEW_BOXOFFICE.uscita = [BOX_DATA], NEW_BOXOFFICE.[DISTRIB BOX-OFFICE] = [BOX_DISTRIBUTORE], NEW_BOXOFFICE.INCASSO = [BOX_INCASSO],NEW_BOXOFFICE.SPETTATORI = [BOX_SPETTATORI], NEW_BOXOFFICE.IMDB = [IMDB_CODICE] ;") 'agggiorna il campo stagione vDb.Execute ("UPDATE NEW_BOXOFFICE INNER JOIN ICR_BD_CINEMA ON NEW_BOXOFFICE.rifer = ICR_BD_CINEMA.CD_PROD SET NEW_BOXOFFICE.STAGIONE = [DS_STAGIONE];") 'prime tv---------------------------------------------------- Set rs2 = vDb.OpenRecordset("SELECT NEW_BOXOFFICE.* FROM NEW_BOXOFFICE " & _ "WHERE rifer Is Not Null;") Do Until rs2.EOF rs2.Edit varPrima_tv = fun_UPDATE_BOXOFFICE_PRIMATV(rs2!Rifer) If varPrima_tv(1, 1) <> "" Then rs2![1TV FREE] = varPrima_tv(1, 1) End If If varPrima_tv(2, 1) <> "" Then rs2![1TV PAY] = varPrima_tv(2, 1) End If If varPrima_tv(3, 1) <> "" Then rs2![network pay] = varPrima_tv(3, 1) End If rs2.UPDATE rs2.MoveNext Loop '--------------------------------------------------------------- 'network free----------------------------------------------------- 'RAI vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'RAI' " & _ "WHERE [1TV FREE] Like 'R*' And [1TV FREE] Not Like 'R4*' and [1TV FREE] Not like 'RT*';") 'MEDIASET vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'MEDIASET' " & _ "WHERE (((NEW_BOXOFFICE.[1TV FREE]) Like 'C5*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'I1*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'R4*' Or 'Or' Like 'LA5*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'I2*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'IRIS*' Or (NEW_BOXOFFICE.[1TV FREE]) Like '20*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'FOC*' Or (NEW_BOXOFFICE.[1TV FREE]) Like 'CI34*'));") 'BOING vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'BOING' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'BG*';") 'LA7 vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'LA7' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'LA*';") 'DISCOVERY vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'DISCOVERY' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'RT*' or (NEW_BOXOFFICE.[1TV FREE]) Like 'NOVE*';") 'SKY vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'SKY' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'CIEL*' or (NEW_BOXOFFICE.[1TV FREE]) Like 'TV8*';") 'SONY vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'SONY' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'SONY*';") 'PARAMOUNT vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.[network free] = 'PARAMOUNT' " & _ "WHERE (NEW_BOXOFFICE.[1TV FREE]) Like 'PA*';") 'check Set rs = vDb.OpenRecordset("SELECT NEW_BOXOFFICE.[network free], NEW_BOXOFFICE.[1TV FREE] " & _ "FROM NEW_BOXOFFICE " & _ "WHERE (((NEW_BOXOFFICE.[network free]) Is Null) AND ((NEW_BOXOFFICE.[1TV FREE]) Is Not Null));") If rs.RecordCount > 0 Then 'MsgBox "Rete non gestita" End If '=========================================================================================== 'verifica se non emesso se c'è un contratto Mediaset vDb.Execute ("UPDATE NEW_BOXOFFICE INNER JOIN CUSTOM_DIRITTI ON NEW_BOXOFFICE.rifer = CUSTOM_DIRITTI.PROD SET NEW_BOXOFFICE.[network free] = 'MEDIASET' " & _ "WHERE (((NEW_BOXOFFICE.[network free]) Is Null) AND ((CUSTOM_DIRITTI.TIPO_DIRITTO)='free') AND ((CUSTOM_DIRITTI.PIATTAFORMA)='analogico'));") 'vDb.Execute ("UPDATE NEW_BOXOFFICE INNER JOIN CUSTOM_DIRITTI ON NEW_BOXOFFICE.rifer = CUSTOM_DIRITTI.PROD SET NEW_BOXOFFICE.[network pay] = 'MEDIASET' " & _ "WHERE (((NEW_BOXOFFICE.[network pay]) Is Null) AND ((CUSTOM_DIRITTI.TIPO_DIRITTO)='Pay - Premium') AND ((CUSTOM_DIRITTI.PIATTAFORMA)='DVB-T'));") '============================================================================================================================================================ '================================================================================================================================ 'aggiunge i film non ancora usciti provenienti dal file Medusa 'vDb.Execute ("INSERT INTO NEW_BOXOFFICE ( uscita, TI, [DISTRIB BOX-OFFICE], RIFER, IMDB, ANNUNCIATO ) " & _ "SELECT Competitive.F1, Competitive.F2, Competitive.F3, IIf([ONAIR_FORZATI] Is Not Null,[ONAIR_FORZATI],[CUSTOM_ANAGR_ORIZ]![RIFER]) AS RIFER, [MMC-FILE_MEDUSA_IMDB].IMDB, 'A' AS Espr1 " & _ "FROM ((Competitive LEFT JOIN [MMC-FILE_MEDUSA_IMDB] ON (Competitive.F2 = [MMC-FILE_MEDUSA_IMDB].Titolo) AND (Competitive.F3 = [MMC-FILE_MEDUSA_IMDB].Distribuzione)) LEFT JOIN CUSTOM_ANAGR_ORIZ ON [MMC-FILE_MEDUSA_IMDB].IMDB = CUSTOM_ANAGR_ORIZ.IMDB_CODICE) LEFT JOIN NEW_BOXOFFICE ON CUSTOM_ANAGR_ORIZ.RIFER = NEW_BOXOFFICE.rifer " & _ "WHERE ((([MMC-FILE_MEDUSA_IMDB].IMDB) Like 'tt*') AND ((Competitive.F2) Is Not Null And (Competitive.F2)<>'Titolo') AND ((NEW_BOXOFFICE.rifer) Is Null));") 'aggiorna dati anagrafici vDb.Execute ("UPDATE NEW_BOXOFFICE INNER JOIN CUSTOM_ANAGR_ORIZ ON NEW_BOXOFFICE.rifer = CUSTOM_ANAGR_ORIZ.RIFER SET NEW_BOXOFFICE.TI = [CUSTOM_ANAGR_ORIZ]![TI], NEW_BOXOFFICE.IMDB = [IMDB_CODICE] ;") 'calcola la stagione vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.STAGIONE = Format([USCITA],'yyyy') & '/' & val(Format([USCITA],'yy')+1) " & _ "WHERE (((NEW_BOXOFFICE.STAGIONE) Is Null) AND ((NEW_BOXOFFICE.uscita) Is Not Null) AND ((Format([uscita],'m'))=8 Or (Format([uscita],'m'))=9 Or (Format([uscita],'m'))=10 Or (Format([uscita],'m'))=11 Or (Format([uscita],'m'))=12));") vDb.Execute ("UPDATE NEW_BOXOFFICE SET NEW_BOXOFFICE.STAGIONE = Format([USCITA],'yyyy')-'1' & '/' & Format([USCITA],'yy') " & _ "WHERE (((NEW_BOXOFFICE.STAGIONE) Is Null) AND ((NEW_BOXOFFICE.uscita) Is Not Null) AND ((Format([uscita],'m'))=1 Or (Format([uscita],'m'))=2 Or (Format([uscita],'m'))=3 Or (Format([uscita],'m'))=4 Or (Format([uscita],'m'))=5 Or (Format([uscita],'m'))=6 Or (Format([uscita],'m'))=7));") 'elimina gli annuciati che tali non sono perchè hanno già un incasso (riproposizioni) vDb.Execute ("DELETE NEW_BOXOFFICE.*, NEW_BOXOFFICE.ANNUNCIATO, CUSTOM_ANAGR_ORIZ.BOX_INCASSO " & _ "FROM NEW_BOXOFFICE INNER JOIN CUSTOM_ANAGR_ORIZ ON NEW_BOXOFFICE.rifer = CUSTOM_ANAGR_ORIZ.RIFER " & _ "WHERE (((NEW_BOXOFFICE.ANNUNCIATO)='A') AND ((CUSTOM_ANAGR_ORIZ.BOX_DATA) Is Not Null));") 'sistema la stagione se mancante negli annuciati vDb.Execute ("SELECT NEW_BOXOFFICE.ANNUNCIATO, Max(NEW_BOXOFFICE.STAGIONE) AS MaxDiSTAGIONE INTO boxoffice_temp " & _ "FROM NEW_BOXOFFICE " & _ "GROUP BY NEW_BOXOFFICE.ANNUNCIATO " & _ "HAVING (((NEW_BOXOFFICE.ANNUNCIATO)='A'));") vDb.Execute ("UPDATE boxoffice_temp INNER JOIN NEW_BOXOFFICE ON boxoffice_temp.ANNUNCIATO = NEW_BOXOFFICE.ANNUNCIATO SET NEW_BOXOFFICE.STAGIONE = [MaxDiSTAGIONE] " & _ "WHERE (((NEW_BOXOFFICE.STAGIONE) Is Null));") vDb.Close '======================================================================================================================== Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\DB_WEEK.accdb", "BOXOFFICE", acTable, "NEW_BOXOFFICE" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True Call sUpdater("End", "BOXOFFICE") Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub errore: If Err.Number = 3376 Then Resume Next ElseIf Err.Number = 7874 Then Resume Next ElseIf Err.Number = 3010 Then vDb.Execute ("drop table " & Mid(Err.Description, 10, InStr(Mid(Err.Description, 10), "'") - 1)) Resume ElseIf Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox "Si è verificato un errore: " & Err.Description Resume End If End Sub Public Function fun_UPDATE_BOXOFFICE_PRIMATV(Rifer As Long) As Variant 'gPath = "I:\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker" 'Set db = OpenDatabase(gPath & "\db_updates.accdb") Set rs = vDb.OpenRecordset("SELECT EM_PG_RETE, EM_PG_DATA, RIFER, EM_PG_HI, EM_PT_RETE, EM_PT_DATA, EM_PT_HI, EM_PP_RETE, EM_PP_DATA, EM_PP_HI " & _ "FROM CUSTOM_ANAGR_ORIZ WHERE CUSTOM_ANAGR_ORIZ.RIFER =" & Rifer & ";") If rs.RecordCount > 0 Then 'Prima free rs.MoveFirst If rs!EM_PG_DATA & "" <> "" And rs!EM_PT_DATA & "" <> "" Then If CVDate(rs!EM_PG_DATA) <= CVDate(rs!EM_PT_DATA) Then varFree = rs!EM_PG_RETE & " " & Format(rs!EM_PG_DATA, "dd/mm/yy") & " " & Left(rs!EM_PG_HI, 2) & "." & Mid(rs!EM_PG_HI, 3, 2) Else varFree = rs!EM_PT_RETE & " " & Format(rs!EM_PT_DATA, "dd/mm/yy") & " " & Left(rs!EM_PT_HI, 2) & "." & Mid(rs!EM_PT_HI, 3, 2) End If ElseIf rs!EM_PG_DATA & "" <> "" And rs!EM_PT_DATA & "" = "" Then varFree = rs!EM_PG_RETE & " " & Format(rs!EM_PG_DATA, "dd/mm/yy") & " " & Left(rs!EM_PG_HI, 2) & "." & Mid(rs!EM_PG_HI, 3, 2) ElseIf rs!EM_PG_DATA & "" = "" And rs!EM_PT_DATA & "" <> "" Then varFree = rs!EM_PT_RETE & " " & Format(rs!EM_PT_DATA, "dd/mm/yy") & " " & Left(rs!EM_PT_HI, 2) & "." & Mid(rs!EM_PT_HI, 3, 2) Else varFree = "" End If End If '1TV pay 'disabilitiamo per il momento: da valutare se mantenere GoTo salta: Set rs = vDb.OpenRecordset("SELECT TOP 1 CUSTOM_EMESSO.CCPROD, CUSTOM_EMESSO.CCRETETEL, CUSTOM_EMESSO.DCDATGIO, CUSTOM_EMESSO.TCORAINIZ, CUSTOM_EMESSO.ICR_MONDO " & _ "FROM CUSTOM_EMESSO " & _ "WHERE (((CUSTOM_EMESSO.CCPROD) = " & Rifer & ") And ((CUSTOM_EMESSO.ICR_MONDO) = 'SKY' Or (CUSTOM_EMESSO.ICR_MONDO) = 'PREMIUM' Or (CUSTOM_EMESSO.ICR_MONDO) = 'FOX')) " & _ "ORDER BY CUSTOM_EMESSO.DCDATGIO;") If rs.RecordCount > 0 Then rs.MoveFirst varPay = rs!CCRETETEL & " " & Format(rs!DCDATGIO, "dd/mm/yy") & " " & Left(rs!TCORAINIZ, 2) & "." & Mid(rs!TCORAINIZ, 3, 2) varMondoPay = rs!ICR_MONDO If varMondoPay = "FOX" Then varMondoPay = "SKY" End If End If salta: fun_UPDATE_BOXOFFICE_PRIMATV = Application.Transpose(Array(varFree, varPay, varMondoPay)) End Function Public Function fun_UPDATE_BOXOFFICE_DISP_EFF(free_pay As String, Rifer As Long) As String 'gPath = "I:\SOFTWARE\ProcedureICR\ICRmonitor\MonitorLinker" 'Set db = OpenDatabase(gPath & "\db_updates.accdb") If free_pay = "PAY" Then Set rs = Db.OpenRecordset("SELECT TOP 1 D.PROD, D.DECR, D.SCAD, D.DECR_WIN_1, D.SCAD_WIN_1, D.DECR_WIN_2, D.SCAD_WIN_2, D.DECR_WIN_3, D.SCAD_WIN_3, D.DECR_WIN_4, D.SCAD_WIN_4 " & _ "FROM ICR_DIRITTI_X_ICR AS D " & _ "WHERE (((D.PROD) = " & Rifer & ") And ((D.TIPO_DIRITTO) = 'Pay - Premium') And ((D.PIATTAFORMA) = 'DVB-T')) " & _ "ORDER BY D.DECR;") End If If free_pay = "FREE" Then Set rs = Db.OpenRecordset("SELECT TOP 1 D.PROD, D.DECR, D.SCAD, D.DECR_WIN_1, D.SCAD_WIN_1, D.DECR_WIN_2, D.SCAD_WIN_2, D.DECR_WIN_3, D.SCAD_WIN_3, D.DECR_WIN_4, D.SCAD_WIN_4 " & _ "FROM ICR_DIRITTI_X_ICR AS D " & _ "WHERE (((D.PROD) = " & Rifer & ") And ((D.TIPO_DIRITTO) = 'Free') And ((D.PIATTAFORMA) = 'Analogico')) " & _ "ORDER BY D.DECR;") End If If rs.RecordCount = 0 Then Disp_Eff = "no diritti" Exit Function End If varNEW_DECR_TENT = "" If rs!DECR_WIN_1 & "" = "" Or rs!DECR_WIN_1 = "01/01/0001" Then 'non ci sono finestre Disp_Eff = rs!DECR & "_" Exit Function End If 'prima finestra If Disp_Eff & "" = "" Then If CVDate(rs!DECR) < CVDate(rs!DECR_WIN_1) Then 'la decorrenza è antecedente alla decorrenza della 1° finestra Disp_Eff = rs!DECR & "_" Exit Function End If If Disp_Eff & "" = "" And rs!DECR_WIN_2 & "" = "" Then 'c'è solo una finestra If CVDate(rs!DECR) < CVDate(rs!SCAD_WIN_1) Then 'la decorrenza cade nel periodo della finestra il diritto decorrerà al termine della finestra altrimenti alla normale decorrenza Disp_Eff = CVDate(rs!SCAD_WIN_1) + 1 & "_f" Exit Function Else 'il diritto decorre dopo la prima finestra Disp_Eff = CVDate(rs!DECR) & "_f" Exit Function End If Else If CVDate(rs!DECR) < CVDate(rs!SCAD_WIN_1) Then varNEW_DECR_TENT = CVDate(rs!SCAD_WIN_1) + 1 Else varNEW_DECR_TENT = CVDate(rs!DECR) End If End If End If 'seconda finestra If Disp_Eff & "" = "" Then If DECR_WIN_3 & "" = "" Then 'c'è solo una seconda finestra If CVDate(varNEW_DECR_TENT) < CVDate(rs!DECR_WIN_2) Then 'la nuova decorrenza tentative è antecedente alla decorenza della 2° finestra e verrà fissata come nuova decorrenza Disp_Eff = CVDate(varNEW_DECR_TENT) & "_f" Exit Function ElseIf CVDate(varNEW_DECR_TENT) >= CVDate(rs!DECR_WIN_2) And CVDate(varNEW_DECR_TENT) <= CVDate(rs!SCAD_WIN_2) Then 'la nuova decorrenza tentattive cade nel periodo della seconda finestra:il diritto decorrerà al termine della 2°finestra Disp_Eff = CVDate(rs!SCAD_WIN_2) + 1 & "_f" Exit Function End If Else If CVDate(rs!DECR) < CVDate(rs!SCAD_WIN_2) Then varNEW_DECR_TENT = CVDate(rs!SCAD_WIN_2) + 1 Else varNEW_DECR_TENT = CVDate(rs!DECR) End If End If End If 'terza finestra If Disp_Eff & "" = "" Then If rs!DECR_WIN_4 & "" = "" Then 'c'è solo una terza finestra If CVDate(varNEW_DECR_TENT) < CVDate(rs!DECR_WIN_3) Then 'la nuova decorrenza tentative è antecedente alla decorenza della 3° finestra e verrà fissata come nuova decorrenza Disp_Eff = CVDate(varNEW_DECR_TENT) & "_f" Exit Function ElseIf CVDate(varNEW_DECR_TENT) >= CVDate(rs!DECR_WIN_3) And CVDate(varNEW_DECR_TENT) <= CVDate(rs!SCAD_WIN_3) Then 'la nuova decorrenza tentattive cade nel periodo della 3° finestra:il diritto decorrerà al termine della 3°finestra Disp_Eff = CVDate(rs!SCAD_WIN_3) + 1 & "_f" Exit Function End If End If End If 'db.Close End Function Public Sub sub_UPDATE_DIRITTI() On Error GoTo errore: Call sUpdater("Start", "DIRITTI") vDb.Execute ("INSERT INTO NEW_CUSTOM_DIRITTI (TIPO_DIRITTO, PIATTAFORMA, TIPOLOGIA, PROD, EDIZ, D_T, RAGSOC_DISTR, PERC, PASS_CONS_TOT, PASS_EFF_TOT, DECR, SCAD, CAUSALE, FLAG_INIB, DECR_INIB, SCAD_INIB, FR_RR, CONTRATTO, RIGA, SITUAZIONE, DECR_WIN_1, SCAD_WIN_1, DECR_WIN_2, SCAD_WIN_2, DECR_WIN_3, SCAD_WIN_3, DECR_WIN_4, SCAD_WIN_4, DECR_WIN_5, SCAD_WIN_5, DECR_WIN_6, SCAD_WIN_6, DECR_WIN_7, SCAD_WIN_7, DECR_WIN_8, SCAD_WIN_8, DECR_WIN_9, SCAD_WIN_9 ) " & _ "SELECT TIPO_DIRITTO,PIATTAFORMA,ICR_DIRITTI_X_ICR.TIPOLOGIA, ICR_DIRITTI_X_ICR.PROD, ICR_DIRITTI_X_ICR.EDIZ, ICR_DIRITTI_X_ICR.D_T, ICR_DIRITTI_X_ICR.RAGSOC_DISTR, ICR_DIRITTI_X_ICR.PERC, ICR_DIRITTI_X_ICR.PASS_CONS_TOT, ICR_DIRITTI_X_ICR.PASS_EFF_TOT, ICR_DIRITTI_X_ICR.DECR, ICR_DIRITTI_X_ICR.SCAD, ICR_DIRITTI_X_ICR.CAUSALE, ICR_DIRITTI_X_ICR.FLAG_INIB, ICR_DIRITTI_X_ICR.DECR_INIB, ICR_DIRITTI_X_ICR.SCAD_INIB, ICR_DIRITTI_X_ICR.FR_RR, ICR_DIRITTI_X_ICR.CONTRATTO, ICR_DIRITTI_X_ICR.RIGA, ICR_DIRITTI_X_ICR.SITUAZIONE, DECR_WIN_1, SCAD_WIN_1, DECR_WIN_2, SCAD_WIN_2, DECR_WIN_3, SCAD_WIN_3, DECR_WIN_4, SCAD_WIN_4, DECR_WIN_5, SCAD_WIN_5, DECR_WIN_6, SCAD_WIN_6, DECR_WIN_7, SCAD_WIN_7, DECR_WIN_8, SCAD_WIN_8, DECR_WIN_9, SCAD_WIN_9 " & _ "FROM ICR_DIRITTI_X_ICR " & _ "WHERE ICR_DIRITTI_X_ICR.TIPO_DIRITTO ='free' AND ICR_DIRITTI_X_ICR.PIATTAFORMA='analogico';") Call sMotivoInibiz Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\DB_WEEK.accdb", "CUSTOM_DIRITTI", acTable, "NEW_CUSTOM_DIRITTI" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True Call sUpdater("End", "DIRITTI") Exit Sub errore: If Err.Number = 3010 Then vDb.Execute ("drop table " & Mid(Err.Description, 10, InStr(Mid(Err.Description, 10), "'") - 1)) Resume ElseIf Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox "Si è verificato un errore: " & Err.Description End If End Sub Public Sub sub_UPDATE_CUSTOM_EMESSO() On Error GoTo errore: Call sUpdater("Start", "CUSTOM_EMESSO") vDb.Execute ("INSERT INTO NEW_CUSTOM_EMESSO ( CCPROD, CCRETETEL, DCDATGIO, TCORAINIZ, TCORAFINE, QCAUDMED, PCSHAREA, FCPRIMAVIS, TCDURLORDA, TCDURNET, ICR_MONDO, ICR_DECOD_RETE_BREVE, CCFASCIA ) " & _ "SELECT ICR_BD_TKBLS010.CCPROD, ICR_BD_TKBLS010.CCRETETEL, ICR_BD_TKBLS010.DCDATGIO, ICR_BD_TKBLS010.TCORAINIZ, ICR_BD_TKBLS010.TCORAFINE, ICR_BD_TKBLS010.QCAUDMED, ICR_BD_TKBLS010.PCSHAREA, ICR_BD_TKBLS010.FCPRIMAVIS, ICR_BD_TKBLS010.TCDURLORDA, ICR_BD_TKBLS010.TCDURNET, EMESSO_TYFX0160.ICR_MONDO, EMESSO_TYFX0160.ICR_DECOD_RETE_BREVE, ICR_BD_TKBLS010.CCFASCIA " & _ "FROM ICR_BD_TKBLS010 LEFT JOIN EMESSO_TYFX0160 ON ICR_BD_TKBLS010.CCRETETEL = EMESSO_TYFX0160.CCRETETEL " & _ "WHERE (((EMESSO_TYFX0160.ICR_MONDO) Like 'CON*' Or (EMESSO_TYFX0160.ICR_MONDO) Like 'MED*'));") vDb.Execute ("UPDATE NEW_CUSTOM_EMESSO INNER JOIN tabPdfEsiste ON NEW_CUSTOM_EMESSO.DCDATGIO = tabPdfEsiste.data SET NEW_CUSTOM_EMESSO.PDF_ESISTE = True " & _ "WHERE (((NEW_CUSTOM_EMESSO.CCRETETEL)='C5' Or (NEW_CUSTOM_EMESSO.CCRETETEL)='I1' Or (NEW_CUSTOM_EMESSO.CCRETETEL)='R4') AND ((NEW_CUSTOM_EMESSO.CCFASCIA)='PR'));") vDb.Close Application.DisplayAlerts = False Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase (ThisWorkbook.path & "\temp\UPDATE.accdb") MsAxs.DoCmd.CopyObject ThisWorkbook.path & "\temp_db\DB_WEEK.accdb", "CUSTOM_EMESSO", acTable, "NEW_CUSTOM_EMESSO" MsAxs.CloseCurrentDatabase Application.DisplayAlerts = True Call sUpdater("End", "CUSTOM_EMESSO") Exit Sub errore: If Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox "Si è verificato un errore: " & Err.Description End If End Sub Public Sub sManutenzione_InfoGlobal() On Error GoTo errore: Call sUpdater("Start", "Manutenzione_InfoGlobal") 'Pulisce la tabella INFO_GLOBAL vDb.Execute ("UPDATE INFO_GLOBAL INNER JOIN GEMMA ON INFO_GLOBAL.GEMMA = GEMMA.KEY_COD SET INFO_GLOBAL.IMDB_FORZATO = Null " & _ "WHERE (((GEMMA.[A_Cod IMDB])=[IMDB_FORZATO]));") vDb.Execute ("DELETE INFO_GLOBAL.NOTA_ICR, INFO_GLOBAL.NETWORK_FREE, INFO_GLOBAL.FORNITORE_DIRITTI, INFO_GLOBAL.IMDB_FORZATO, INFO_GLOBAL.VegTentative, INFO_GLOBAL.[dismesso-PropostaGiro] " & _ "FROM INFO_GLOBAL " & _ "WHERE (((INFO_GLOBAL.NOTA_ICR) Is Null) AND ((INFO_GLOBAL.NETWORK_FREE) Is Null) AND ((INFO_GLOBAL.FORNITORE_DIRITTI) Is Null) AND ((INFO_GLOBAL.IMDB_FORZATO) Is Null) AND ((INFO_GLOBAL.VegTentative) Is Null) AND ((INFO_GLOBAL.[dismesso-PropostaGiro]) Is Null));") Call sUpdater("End", "Manutenzione_InfoGlobal") Exit Sub errore: If Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox (Err.Description) End If End Sub Public Sub sManutenzione_CalRicStato() 'tabella GEMMA, aggiunge CalRicStato l'ultimo stato delle richieste tenendo conto dell'anno di budget On Error GoTo errore: Call sUpdater("Start", "Manutenzione_CalRicStato") 'Se esiste un codice Imdb ma manca codice Gemma lo aggiorna in Richieste a condizione che ci sia un solo codice Gemma in comune vDb.Execute ("SELECT RICHIESTE_DETT.IMDB, GEMMA.KEY_COD INTO temp " & _ "FROM RICHIESTE_DETT INNER JOIN GEMMA ON RICHIESTE_DETT.IMDB = GEMMA.[A_Cod IMDB] " & _ "WHERE (((RICHIESTE_DETT.KEY_COD) Is Null)) " & _ "GROUP BY RICHIESTE_DETT.IMDB, GEMMA.KEY_COD " & _ "HAVING (((RICHIESTE_DETT.IMDB) Like 'tt*') AND ((Count(GEMMA.KEY_COD))=1));") vDb.Execute ("UPDATE temp INNER JOIN RICHIESTE_DETT ON temp.IMDB = RICHIESTE_DETT.IMDB SET RICHIESTE_DETT.KEY_COD = [temp]![KEY_COD]" & _ "WHERE (((RICHIESTE_DETT.KEY_COD) Is Null));") vDb.Execute ("drop table temp") 'Valorizza il campo CalRicStato su Gemma con lo stato considerando l'ultimo anno di budget vDb.Execute ("SELECT RICHIESTE_DETT.KEY_COD, Max(RICHIESTE_MAIN.ANNO_BUDGET) AS MaxDiANNO_BUDGET INTO temp " & _ "FROM RICHIESTE_MAIN INNER JOIN RICHIESTE_DETT ON RICHIESTE_MAIN.KEY_COMMESSA = RICHIESTE_DETT.EXT_KEY_COMMESSA " & _ "WHERE (((RICHIESTE_MAIN.STATO) Is Not Null)) " & _ "GROUP BY RICHIESTE_DETT.KEY_COD " & _ "HAVING (((RICHIESTE_DETT.KEY_COD) Is Not Null)) " & _ "ORDER BY RICHIESTE_DETT.KEY_COD, Max(RICHIESTE_MAIN.ANNO_BUDGET) DESC;") vDb.Execute ("SELECT temp.KEY_COD, First(RICHIESTE_MAIN.STATO) AS PrimoDiSTATO INTO temp2 " & _ "FROM RICHIESTE_MAIN INNER JOIN (temp INNER JOIN RICHIESTE_DETT ON temp.KEY_COD = RICHIESTE_DETT.KEY_COD) ON (temp.MaxDiANNO_BUDGET = RICHIESTE_MAIN.ANNO_BUDGET) AND (RICHIESTE_MAIN.KEY_COMMESSA = RICHIESTE_DETT.EXT_KEY_COMMESSA) " & _ "GROUP BY temp.KEY_COD;") vDb.Execute ("UPDATE GEMMA INNER JOIN temp2 ON GEMMA.KEY_COD = temp2.KEY_COD SET GEMMA.CalRicStato = [PrimoDiSTATO];") vDb.Execute ("drop table temp") vDb.Execute ("drop table temp2") Call sUpdater("End", "Manutenzione_CalRicStato") Exit Sub errore: If Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox (Err.Number) MsgBox (Err.Description) End If End Sub Public Sub sMotivoInibiz() Dim vN As Integer Dim vX As Integer Dim rs As Recordset Dim vInibizione As String On Error GoTo errore: '============================================= Dim StartTime As Double Dim SecondsElapsed As Double 'Remember time when macro starts StartTime = Timer '========================================== For vN = 2015 To Val(Format(Date, "yyyy")) + 5 Set rs = vDb.OpenRecordset("SELECT NEW_CUSTOM_DIRITTI.PROD as Rifer,calMotivoInibiz " & _ "FROM NEW_CUSTOM_DIRITTI " & _ "WHERE (((NEW_CUSTOM_DIRITTI.DECR)<=#12/31/" & vN & "#) AND ((NEW_CUSTOM_DIRITTI.SCAD)>=#1/1/" & vN & "#) AND ((NEW_CUSTOM_DIRITTI.TIPOLOGIA)='FILM' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='MINISERIE' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='SIT COM' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='TELEFILM' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='TV MOVIE' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='SOAP' Or (NEW_CUSTOM_DIRITTI.TIPOLOGIA)='TELENOVELAS'));") rs.MoveFirst Do Until rs.EOF 'If rs!Rifer = 31095 And vN = 2024 Then 'MsgBox "STOP" 'End If vInibizione = fun_ANALISI_LIBRARY__DisponibilitaNetta_v01(rs!Rifer, "01/01/" & vN, "31/12/" & vN) If vInibizione <> "" Then rs.Edit If IsNull(rs!CalMotivoInibiz) Then rs!CalMotivoInibiz = "|" & Left(vInibizione, 4) & "_" & vN & "|" Else If InStr(rs!CalMotivoInibiz, vN) = 0 Then rs!CalMotivoInibiz = rs!CalMotivoInibiz & "|" & Left(vInibizione, 4) & "_" & vN & "|" End If End If rs.UPDATE End If rs.MoveNext Loop Next vN '=============================================================================================== 'crea nuovo campo con fr/rr ricalcolati per gestire situazioni anomale in MonitorAcquisti vDb.Execute ("UPDATE NEW_CUSTOM_DIRITTI SET NEW_CUSTOM_DIRITTI.CalFrRr = IIf([FR_RR]='R','R','F');") vDb.Execute ("UPDATE NEW_CUSTOM_DIRITTI AS 1 INNER JOIN NEW_CUSTOM_DIRITTI AS 2 ON [1].PROD = [2].PROD SET [1].CalFrRr = 'R' " & _ "WHERE ((([1].CalFrRr)='F') AND ((Format([2]![DECR],'yyyy'))1001));") '======================================================================================= '================================================================================ 'Determine how many seconds code took to run SecondsElapsed = Round(Timer - StartTime, 2) 'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation '============================================================================= Exit Sub errore: If Err.Number = 91 Then Call basUtility.sRicollegaDb Resume End If MsgBox Err.Description End Sub Public Function fun_ANALISI_LIBRARY__DisponibilitaNetta_v01(Rifer As Long, Dal, Al) As Variant Dim varDN_inibito Dim rs As Recordset Dim varNrRecord Dim varDN_PercInf100 Dim varDN_GG_disp Dim c Dim varDN_GG_BloccoWindows Dim X Dim varDN_decr_win Dim varDN_scad_win varDN_inibito = "" Set rs = vDb.OpenRecordset("SELECT PROD, PERC, DECR, SCAD, FLAG_INIB, PERC, PASS_CONS_TOT, PASS_EFF_TOT, " & _ "DECR_WIN_1, SCAD_WIN_1, DECR_WIN_2, SCAD_WIN_2, DECR_WIN_3, SCAD_WIN_3, DECR_WIN_4, SCAD_WIN_4, DECR_WIN_5, SCAD_WIN_5, DECR_WIN_6, SCAD_WIN_6, DECR_WIN_7, SCAD_WIN_7, DECR_WIN_8, SCAD_WIN_8, DECR_WIN_9, SCAD_WIN_9 " & _ "FROM NEW_CUSTOM_DIRITTI " & _ "WHERE (((PROD)=" & Rifer & ") AND ((DECR)<=#" & CVDate(Al) & "#) AND ((SCAD)>=#" & CVDate(Dal) & "#));") 'varGiorni = (CVDate(al) - CVDate(dal) + 1) Dim Matrice_GG_Diritti(1 To 5000) rs.MoveLast varNrRecord = rs.RecordCount rs.MoveFirst Do Until rs.EOF varDN_inibito = "" 'controlla se i passaggi residui sono a 0 If rs![PASS_CONS_TOT] - rs![PASS_EFF_TOT] <= 0 Then varDN_inibito = "passaggi esauriti" End If 'controlla se inibito If rs!FLAG_INIB <> "" Then varDN_inibito = "inibito" End If 'controlla se inferiore a 100% varDN_PercInf100 = varDN_PercInf100 + rs!PERC 'controlla i giorni di disponibilità varDN_GG_disp = 0 For c = 1 To (CVDate(Al) - CVDate(Dal)) If rs!DECR <= CVDate(Dal) + (c - 1) And rs!SCAD >= CVDate(Dal) + (c - 1) Then Matrice_GG_Diritti(c) = "D" varDN_GG_disp = varDN_GG_disp + 1 End If Next c GoTo salto: 'controlla se esiste una finestra varDN_GG_BloccoWindows = 0 If varDN_inibito = "" Then For X = 1 To 9 varDN_decr_win = "DECR_WIN_" & X varDN_scad_win = "SCAD_WIN_" & X If rs.Fields(varDN_decr_win) <> "" Then If CVDate(rs.Fields(varDN_scad_win)) >= CVDate(Dal) Then For c = 1 To (CVDate(Al) - CVDate(Dal)) If CVDate(rs.Fields(varDN_decr_win)) <= CVDate(Dal) + (c - 1) And CVDate(rs.Fields(varDN_scad_win)) >= CVDate(Dal) + (c - 1) Then If Matrice_GG_Diritti(c) = "D" Then Matrice_GG_Diritti(c) = "" varDN_GG_BloccoWindows = varDN_GG_BloccoWindows + 1 End If End If Next c End If End If Next X End If salto: '------------------------------------------- 'nel caso di piu righe di diritto, se almeno una riga è valida allora il prodotto non è da inibire If varNrRecord > 1 And varDN_inibito = "" And varDN_PercInf100 >= 100 And (varDN_GG_disp - varDN_GG_BloccoWindows) > 30 Then Exit Do End If rs.MoveNext Loop If varDN_PercInf100 < 100 Then varDN_inibito = "<100%" End If If varDN_GG_disp - varDN_GG_BloccoWindows < 30 Then varDN_inibito = "<30gg" End If Dim a As String Dim b As String 'se inibito verifica se il prodotto è stato emesso nell'anno sulle nostre reti generaliste e nel caso annulla l'inibizione. 'GoTo salto: If varDN_inibito <> "" Then Set rs = vDb.OpenRecordset("SELECT CCPROD " & _ "FROM CUSTOM_EMESSO " & _ "WHERE (((CCPROD)=" & Rifer & ") AND ((DCDATGIO)>=#" & CVDate(Dal) & "# And (DCDATGIO)<=#" & CVDate(Al) & "#) AND (ICR_MONDO='MED_GEN' Or ICR_MONDO='MED_TEM'));") If rs.RecordCount > 0 Then varDN_inibito = "" End If End If 'salto: 'a = fun_ANALISI_LIBRARY__DisponibilitaNetta_v01 = varDN_inibito End Function Public Sub sub_UPDATE_GEMMA_ONAIRPLUS() On Error GoTo errore: Call sUpdater("Start", "GEMMA_ONIARPLUS") vDb.Execute ("SELECT Min(GEMMA.KEY_COD) AS MinDiKEY_COD, DB_WEEK_CUSTOM_ANAGR_ORIZ.RIFER INTO temp " & _ "FROM GEMMA INNER JOIN DB_WEEK_CUSTOM_ANAGR_ORIZ ON GEMMA.[A_Cod IMDB] = DB_WEEK_CUSTOM_ANAGR_ORIZ.IMDB_CODICE " & _ "GROUP BY DB_WEEK_CUSTOM_ANAGR_ORIZ.RIFER;") vDb.Execute ("SELECT temp.MinDiKEY_COD, temp.RIFER, GEMMA.V_C5 AS C5, GEMMA.V_I1 AS I1, GEMMA.V_R4 AS R4, GEMMA.V_LA5 AS LA5, GEMMA.V_I2 AS I2, GEMMA.V_IRIS AS IRIS, GEMMA.V_TOP AS [TOP], GEMMA.V_FOC AS FOC, GEMMA.V_C20 AS C20, GEMMA.V_CI34 AS CI34, GEMMA.V_INF AS INF, '' AS [RDA GEN], '' AS [RDA TEM] INTO temp2 " & _ "FROM temp INNER JOIN GEMMA ON temp.MinDiKEY_COD = GEMMA.KEY_COD;") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA GEN] = Left([V_RDA],InStr([V_RDA],';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((Left(Left([V_RDA],InStr([V_RDA],';')),3))=' C5' Or (Left(Left([V_RDA],InStr([V_RDA],';')),3))=' I1' Or (Left(Left([V_RDA],InStr([V_RDA],';')),3))=' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA TEM] = Left([V_RDA],InStr([V_RDA],';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((Left(Left([V_RDA],InStr([V_RDA],';')),3))<>' C5' And (Left(Left([V_RDA],InStr([V_RDA],';')),3))<>' I1' And (Left(Left([V_RDA],InStr([V_RDA],';')),3))<>' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA GEN] = [RDA GEN] & Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((InStr(30,[V_RDA],';'))>0) AND ((Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))=' C5' Or (Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))=' I1' Or (Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))=' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA TEM] = [RDA TEM] & Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((InStr(30,[V_RDA],';'))>0) AND ((Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))<>' C5' And (Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))<>' I1' And (Left(Mid([V_RDA],InStr([V_RDA],';')+1,InStr(Mid([V_RDA],InStr([V_RDA],';')+1),';')),3))<>' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA GEN] = [RDA GEN] & Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((InStr(50,[V_RDA],';'))>0) AND ((Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' C5' Or (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' I1' Or (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA GEN] = [RDA GEN] & Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((InStr(50,[V_RDA],';'))>0) AND ((Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' C5' Or (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' I1' Or (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))=' R4'));") vDb.Execute ("UPDATE temp2 INNER JOIN GEMMA ON temp2.MinDiKEY_COD = GEMMA.KEY_COD SET temp2.[RDA TEM] = [RDA TEM] & Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')) " & _ "WHERE (((GEMMA.V_RDA) Is Not Null) AND ((InStr(50,[V_RDA],';'))>0) AND ((Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))<>' C5' And (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))<>' I1' And (Left(Mid([V_RDA],InStr(30,[V_RDA],';')+1,InStr(Mid([V_RDA],InStr(30,[V_RDA],';')+1),';')),3))<>' R4'));") vDb.Execute ("SELECT RIFER, C5, I1, R4 , LA5, I2, IRIS, TOP, FOC, C20, CI34 , INF, [RDA GEN], [RDA TEM] INTO FILE " & _ "FROM temp2;") 'DISABILITATO PER IL MOMENTO: NON SI TRAVASANO, DA VERIFICARE IL PERCHE' 'integra le valutazioni del sinottico. Il codice precedente potrebbe essere mofificato per prendere le valutazioni dal nuovo file delle valutazioni 'Db.Execute ("INSERT INTO FILE ( RIFER, C5, I1, R4, LA5, I2, IRIS, [TOP], FOC, C20, CI34 ) " & _ "SELECT CUSTOM_ANAGR_ORIZ.RIFER, VALUTAZIONI.C5, VALUTAZIONI.I1, VALUTAZIONI.R4, VALUTAZIONI.LA5, VALUTAZIONI.I2, VALUTAZIONI.IRIS, VALUTAZIONI.TOP, VALUTAZIONI.FOC, VALUTAZIONI.C20, VALUTAZIONI.CI34 " & _ "FROM CUSTOM_ANAGR_ORIZ INNER JOIN VALUTAZIONI ON CUSTOM_ANAGR_ORIZ.IMDB_CODICE = VALUTAZIONI.IMDB " & _ "WHERE (((VALUTAZIONI.ORIGINE)='S') AND ((CUSTOM_ANAGR_ORIZ.EM_PG_RETE) Is Null) AND ((CUSTOM_ANAGR_ORIZ.EM_PT_RETE) Is Null));") vDb.Execute ("DELETE [C5], [I1], [R4], [LA5], [I2], [IRIS], [TOP], [FOC], [C20], [CI34], [INF], [RDA GEN], [RDA TEM] " & _ "FROM FILE " & _ "WHERE ((([C5]) Is Null) AND (([I1]) Is Null) AND (([R4]) Is Null) AND (([LA5]) Is Null) AND (([I2]) Is Null) AND (([IRIS]) Is Null) AND (([TOP]) Is Null) AND (([FOC]) Is Null) AND (([C20]) Is Null) AND (([CI34]) Is Null) AND (([INF]) Is Null) AND (([RDA GEN]) Is Null) AND (([RDA TEM]) Is Null));") Set MsAxs = New Access.Application MsAxs.OpenCurrentDatabase ThisWorkbook.path & "\temp\UPDATE.accdb" DoCmd.OutputTo acOutputTable, "FILE", "Excel97-Excel2003Workbook(*.xls)", ThisWorkbook.path & "\FTP\FILE.xls", False, "", , acExportQualityScreen MsAxs.CloseCurrentDatabase Workbooks.Open ThisWorkbook.path & "\FTP\FILE.xls" Application.DisplayAlerts = False Workbooks("FILE.xls").SaveAs ThisWorkbook.path & "\FTP\FILE.xls", FileFormat:=56 Workbooks("FILE.xls").Close SaveChanges:=True Call sUpdater("End", "GEMMA_ONIARPLUS") Exit Sub errore: If Err.Number = 3000 Or Err.Number = 4045 Then Resume Else MsgBox "Si è verificato un errore: " & Err.Description End If End Sub