Vídeo recomendado
https://youtu.be/diWPPPhW-9E

SQL VBA Exce Array

Discussões sobre a integração do Excel com o Banco de Dados Access

Moderador: joseA

genebaldorios
Colaborador
Colaborador
Mensagens: 16
Registrado em: Qua Jul 19, 2017 10:59 pm

SQL VBA Exce Array

Mensagem por genebaldorios »

<t>Pessoal, boa noite!<br/>
<br/>
Por gentileza, poderiam le ajudar numa duvida de sql excel vba?<br/>
<br/>
Uso um código para fazer update quando id da plan origem = id plan destino usando join é fazendo for pelas colunas sem precisar o nome usando arrColunas. Entre duas planilhas da mesma pasta trabalho funciona.<br/>
<br/>
Porém, ao testar entre planilha pasta trabalho diferentes não funciona. <br/>
<br/>
Sub SQL_VBA_Excel_Array()<br/>
<br/>
Dim ultLin As Long<br/>
Dim uColO As Long<br/>
Dim ws As Excel.Worksheet<br/>
Dim cnx As New ADODB.Connection<br/>
Dim rs As New ADODB.Recordset<br/>
Dim sql As String<br/>
Dim strsQL As String<br/>
Dim i As Long<br/>
Dim ii As Long<br/>
Dim arrColuna()<br/>
<br/>
<br/>
Set ws = Planilha3<br/>
Set wsr = wsResultado<br/>
<br/>
'On Error GoTo TrataErro 'Poderá ser On Error Resume Next, se quiser ignorar<br/>
<br/>
With cnx<br/>
.Provider = "Microsoft.ACE.OLEDB.12.0"<br/>
'.ConnectionString = "Data Source=D:\SQL - Excel\testes\DBases.xlsx"<br/>
.ConnectionString = "Data Source=" & ThisWorkbook.FullName<br/>
.Properties("Extended Properties") = "Excel 12.0 Xml;HDR=YES"<br/>
.Open<br/>
End With<br/>
<br/>
sql = " Select * From [Resultados$] where 1 <> 1"<br/>
<br/>
rs.Open sql, cnx<br/>
<br/>
ReDim arrColuna(rs.Fields.Count - 1)<br/>
<br/>
ii = 0<br/>
For i = 0 To UBound(arrColuna)<br/>
arrColuna(ii) = rs.Fields(i).name<br/>
Next<br/>
rs.Close<br/>
<br/>
strsQL = "Update [Resultados$] Set " & Join(arrColuna, "," & vbCrLf) = ws.Range("B2").value & " where [ID] =1"<br/>
<br/>
cnx.Execute strsQL<br/>
cnx.Close<br/>
End Sub</t>
Editado pela última vez por genebaldorios em Seg Out 22, 2018 7:02 am, em um total de 2 vezes.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: SQL VBA Exce Array

Mensagem por Reinaldo »

Cross Post https://gurudoexcel.com/forum/viewtopic.php?f=12&t=8054
A rotina aqui postada está um pouco diferente da postada no forum Guru, mas vejamos:
...ao testar entre planilha pasta trabalho diferentes não funciona...
Não consegui identificar as bases diferentes, como e feita a seleção/conexão
...sem precisar o nome usando arrColuna...
E redimensionada a array arrColuna, porem o valor dos nomes de colunas atraves do "for" são sempre "alocados" em arrColuna(0) -->"ii=0" Qual o objetivo/necessidade?
...usando inner join
Onde é utilizado inner Join? o Join na montagem da strSQL -->"Join(arrColuna, "," & vbCrLf)" refere-se a função vba Join e não instrução sql "JOIN"
do help vba
Função Join : Retorna uma seqüência de caracteres criada pela associação de diversas subseqüências de caracteres contidas em uma matriz


genebaldorios
Colaborador
Colaborador
Mensagens: 16
Registrado em: Qua Jul 19, 2017 10:59 pm

Re: SQL VBA Exce Array

Mensagem por genebaldorios »

Reinaldo,
Primeiramente agradeço!

Referente a : Não consegui identificar as bases diferentes, como e feita a seleção/conexão
Perdão comentei a linha de código incorretamente:
essa é a linha da conexão com a pasta trabalho externa:
.ConnectionString = "Data Source=D:\SQL - Excel\testes\DBases.xlsx"

E redimensionada a array arrColuna, porem o valor dos nomes de colunas atraves do "for" são sempre "alocados" em arrColuna(0) -->"ii=0" Qual o objetivo/necessidade?
Fazer for das colunas matriz ArrColunas e depois usar a arrColunas dentro do Update
Onde é utilizado inner Join? o Join na montagem da strSQL -->"Join(arrColuna, "," & vbCrLf)" refere-se a função vba Join e não instrução sql "JOIN"
Nesse caso o Join concatena nome da coluna com vírgula para separar as colunas já que passando todas as colunas de uma vez no SET em vez de informar o nome de todas que seria assim:
Sub SQL_Excel_ADO_Join()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim varCampos As Variant
Dim varValores As Variant
Dim strSQL As String
Dim i As Long
Dim ii As Long
Dim ws As Worksheet
Dim ultLin As Long
Dim ultCol As Long
Dim m
Dim arrColuna() As String

Set ws = Planilha3

ultLin = ws.UsedRange.Rows.Count
ultCol = ws.UsedRange.Columns.Count
m = ws.Range(ws.Cells(2, 1), ws.Cells(ultLin, ultCol)).Value2

varCampos = Array(ws.Range("B1"), ws.Range("C1"), ws.Range("D1"))

With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
'.ConnectionString = "Data Source=D:\SQL - Excel\testes\DBases.xlsx"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName
.Properties("Extended Properties") = "Excel 12.0 Xml;HDR=YES"
.Open
End With

' redimenciona a array que receberá as strings dos campos
ReDim Preserve arrColuna(rs.fields.Count)

For i = LBound(m, 1) To UBound(m, 1)
' preenche array
ii = 0
For j = 0 To rs.fields.Count - 1
If UCase("[" & rs.fields(i).name & "]") <> "ID" Then
arrColuna(ii) = "[" & rs.fields(i).name & "]"
End If
strSQL = "UPDATE [Resultado$] SET " & Join(varCampos, ",") & " = " & Join(m(i - 1, j), ",")
strSQL = strSQL & " WHERE [ID]= " & m(i - 1, 1)

Next j
Debug.Print strSQL
cn.Execute (strSQL)
Next i

End Sub

Anexei os dois arquivos zipados e tela de erro.
Anexos
tela join.JPG
tela join.JPG (42.1 KiB) Exibido 11921 vezes
Arquivos-origem e destino.zip
(4.2 MiB) Baixado 589 vezes
Editado pela última vez por genebaldorios em Seg Out 22, 2018 7:36 am, em um total de 1 vez.


genebaldorios
Colaborador
Colaborador
Mensagens: 16
Registrado em: Qua Jul 19, 2017 10:59 pm

Re: SQL VBA Exce Array

Mensagem por genebaldorios »

Essas, em anexo, são as telas das duas pastas de trabalho:
Uma pasta trabalho tem a planilha "base" e noutra pastra trabaho a planilha "Resultado"
Anexos
SQL_Update.JPG
SQL_Update.JPG (236.61 KiB) Exibido 12090 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder