unisci fogli tramite sql

Attribute VB_Name = "unisci_fogli_tramite_sql"

'

Option Explicit

'

' tramite istruzione sql

' raggruppa in nuovo foglio i dati di due fogli

' contenenti la medesima intestazione di colonna.

' esempio:

' Foglio1, cella a1 = articolo

' Foglio2, cella a1 = articolo

'

Sub componiStringaSql()

'

Dim stringasql As String, fogliodestinazione

Dim foglio1, foglio2

foglio1 = "Foglio1"

foglio2 = "Foglio2"

'

stringasql = ""

stringasql = stringasql & " Select * from [" & foglio1 & "$]"

stringasql = stringasql & " UNION "

stringasql = stringasql & " Select * from [" & foglio2 & "$]"

'

Sheets.Add

fogliodestinazione = ActiveSheet.Name

Call EseguiSqlExcel(stringasql, fogliodestinazione)

'

End Sub

'

Sub EseguiSqlExcel(stringasql As String, fogliodestinazione)

'On Error Resume Next

Dim oggConnection, oggRecordset, rifcartella, i

rifcartella = ThisWorkbook.FullName

Const adOpenStatic = 3

Const adLockOptimistic = 3

Const adCmdText = &H1



Set oggConnection = CreateObject("ADODB.Connection")

Set oggRecordset = CreateObject("ADODB.Recordset")



oggConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & rifcartella & ";" & _

"Extended Properties=""Excel 8.0;HDR=Yes;"";"

'

oggRecordset.Open stringasql, oggConnection, adOpenStatic, adLockOptimistic, adCmdText

'

' intestazione - nome campi

'

For i = 0 To oggRecordset.Fields.Count - 1

Sheets(fogliodestinazione).Cells(1, (i + 1)) = oggRecordset.Fields(i).Name

Next

'

' scrive il recordset

Sheets(fogliodestinazione).Range("A2").CopyFromRecordset oggRecordset

'

End Sub

'