ESECUZIONE DI MACRO REGISTRATA IN EXCEL VBA

[orione1943]

I recorded a macro via ODBC that fetches data from an ORACLE query

At the end of the recording, the macro populates the worksheet with the extracted data.

ERRORE DI RUNTIME 9

INDICE NON INCLUSO NELL'INTERVALLO

Here is the registered code:

With ActiveWorkbook.Connections("Query da META64").ODBCConnection

Why does it extract the data from me the first time and when I rerun it does it go wrong?

Why does it say "index not included in the range"?

Thanks for the answers

But when I rerun the macro it immediately crashes at the first line:

and tells me.

ECCO IL CODICE COMPLETO

Sub TAMPONI_17062021()
'
' TAMPONI_17062021 Macro
'

'
With ActiveWorkbook.Connections("Query da META64").ODBCConnection
.BackgroundQuery = True
.CommandText = Array( _
"SELECT TAMPONI_28052021_V2.""ID ACCETTAZIONE"", TAMPONI_28052021_V2.NOME, TAMPONI_28052021_V2.COGNOME, TAMPONI_280520" _
, _
"21_V2.""DATA NASCITA"", TAMPONI_28052021_V2.SESSO, TAMPONI_28052021_V2.""IDENTIFICATIVO DOCUMENTO"", TAMPONI_28052021_V" _
, _
"2.""TIPO DOCUMENTO"", TAMPONI_28052021_V2.""COMUNE DOMICILIO"", TAMPONI_28052021_V2.""DATA INIZIO SINTOMI"", TAMPONI_2805" _
, _
"2021_V2.""DATA PRELIEVO"", TAMPONI_28052021_V2.""ORA PRELIEVO"", TAMPONI_28052021_V2.""DATA ACCETTAZIONE"", TAMPONI_28052" _
, _
"021_V2.""ORA ACCETTAZIONE"", TAMPONI_28052021_V2.""DATA REFERTO"", TAMPONI_28052021_V2.""ORA REFERTO"", TAMPONI_28052021_" _
, _
"V2.""OSPEDALE DI PROVENIENZA"", TAMPONI_28052021_V2.ESITO, TAMPONI_28052021_V2.CF, TAMPONI_28052021_V2.""TELEFONO PAZI" _
, _
"ENTE"", TAMPONI_28052021_V2.""EMAIL PAZIENTE"", TAMPONI_28052021_V2.SETTING, TAMPONI_28052021_V2.PROVENIENZA, TAMPONI_" _
, _
"28052021_V2.MATERIALE, TAMPONI_28052021_V2.GENOTIPIZZAZIONE" & Chr(13) & "" & Chr(10) & "FROM META.TAMPONI_28052021_V2 TAMPONI_28052021_V2" & Chr(13) & "" & Chr(10) & "ORD" _
, "ER BY TAMPONI_28052021_V2.""ID ACCETTAZIONE""")
.CommandType = xlCmdSql
.Connection = Array(Array( _
"ODBC;DSN=META64;UID=META;PWD=META;DBQ=META;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;N" _
), Array( _
"UM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;TSZ=8192;"))
.RefreshOnFileOpen = False
.SavePassword = True
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Query da META64")
.Name = "Query da META64"
.Description = ""
End With
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=META64;UID=META;PWD=META;DBQ=META;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;N" _
), Array( _
"UM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;TSZ=8192;")) _
, Destination:=Range("$A$1")).QueryTable
' .CommandType = 0
.CommandText = Array( _
"SELECT TAMPONI_28052021_V2.""ID ACCETTAZIONE"", TAMPONI_28052021_V2.NOME, TAMPONI_28052021_V2.COGNOME, TAMPONI_280520" _
, _
"21_V2.""DATA NASCITA"", TAMPONI_28052021_V2.SESSO, TAMPONI_28052021_V2.""IDENTIFICATIVO DOCUMENTO"", TAMPONI_28052021_V" _
, _
"2.""TIPO DOCUMENTO"", TAMPONI_28052021_V2.""COMUNE DOMICILIO"", TAMPONI_28052021_V2.""DATA INIZIO SINTOMI"", TAMPONI_2805" _
, _
"2021_V2.""DATA PRELIEVO"", TAMPONI_28052021_V2.""ORA PRELIEVO"", TAMPONI_28052021_V2.""DATA ACCETTAZIONE"", TAMPONI_28052" _
, _
"021_V2.""ORA ACCETTAZIONE"", TAMPONI_28052021_V2.""DATA REFERTO"", TAMPONI_28052021_V2.""ORA REFERTO"", TAMPONI_28052021_" _
, _
"V2.""OSPEDALE DI PROVENIENZA"", TAMPONI_28052021_V2.ESITO, TAMPONI_28052021_V2.CF, TAMPONI_28052021_V2.""TELEFONO PAZI" _
, _
"ENTE"", TAMPONI_28052021_V2.""EMAIL PAZIENTE"", TAMPONI_28052021_V2.SETTING, TAMPONI_28052021_V2.PROVENIENZA, TAMPONI_" _
, _
"28052021_V2.MATERIALE, TAMPONI_28052021_V2.GENOTIPIZZAZIONE" & Chr(13) & "" & Chr(10) & "FROM META.TAMPONI_28052021_V2 TAMPONI_28052021_V2" & Chr(13) & "" & Chr(10) & "ORD" _
, "ER BY TAMPONI_28052021_V2.""ID ACCETTAZIONE""")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Tabella_Query_da_META64"
.Refresh BackgroundQuery:=False
End With
End Sub

[#2]

After your macro has been run once, use the RefreshAll button on the Data tab to get new data.

[#3]

@Jan Karel Pieterse 

The macro is timed and at every hour it must fetch data from an Oracle query.

When I run the registered code it freezes at the first line

I enclose the code and the error

   With ActiveWorkbook.Connections("Query da META64").ODBCConnection

Your suggestion does not work.

Thank you anyway.

Gianmario Polenghi

[#4]

Are you saying refresh all does not work?

[#5]

I'll explain how the macro works.
It is a timed macro every hour it has to fetch data from an Oracle query and load it into an Excel sheet.
This sheet is moved to a new folder and is saved in a CSV format
So there is no more data on the initial folder.
After an hour, the macro was triggered again
I am attaching the folder

[#6]

@orione1943 

[#7]

@orione1943 

Instead of deleting the queries in your code and adding them back again every time, keep the queries. You can then simply refresh the queries and copy the worksheet where they are on to a new blank workbook and save that as a CSV:

    nomefoglio = Format(Date, "yyyymmdd") + "_" + Format(Time, "hhmm") + "molecolari"
    nomefile = Format(Date, "yyyymmdd") + "_" + Format(Time, "hhmm") + "_MOLECOLARI" + ".csv"
    'JKP: Copy the active sheet to a new workbook
    ActiveSheet.Copy
    ActiveSheet.Name = nomefoglio
    Sheets(nomefoglio).Move
    '*******************************

    ActiveWorkbook.SaveAs Filename:= _
                          "C:\Users\test_screening\Documents\TAMPONI\" & nomefile, FileFormat:= _
                          xlCSVMSDOS, CreateBackup:=False
    'ActiveWorkbook.Save
    'ActiveWindow.Close
    ActiveWorkbook.Close SaveChanges:=True

[#8]

@Jan Karel Pieterse 

Ho sostituito il codice precedente con questo codice:

Sub salva()
'Salva molecolari
ActiveWorkbook.RefreshAll
nomefile = Format(Date, "yyyymmdd") + "_" + Format(Time, "hhmm") + "_MOLECOLARI" + ".csv"
ActiveWorkbook.RefreshAll
Sheets("MOLECOLARI").Select
Sheets("MOLECOLARI").Copy
'****************************************
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\test_screening\Documents\TAMPONI\" & nomefile, FileFormat:= _
xlCSVMSDOS, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=True

'*************************************************
nomefile = Format(Date, "yyyymmdd") + "_" + Format(Time, "hhmm") + "_RAPIDI" + ".csv"
Sheets("RAPIDI").Select
Sheets("RAPIDI").Copy
'****************************************
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\test_screening\Documents\ANTIGENE\" & nomefile, FileFormat:= _
xlCSVMSDOS, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=True
Sheets("Foglio1").Select

Call test
End Sub

Funziona

Il tuo suggerimento è stato illuminante

Grazie e buona giornata

Gianmario Polenghi Bergamo Italy