Exportar 2 tablas de SQL en dos hojas de Excel

Necesito otra vez de su ayuda
Lo que estoy tratando de hacer es exportar dos tablas (usuarios y clientes) de sql a excel.
Tengo el siguiente código; pero solo me exporta la tabla usuarios más no sé cómo hacer para que también me exporte la tabla clientes en el mismo código en la hoja que se llama clientes.

Dim strDBNAME As String
Dim strQuery, strQuery2, txtcliente As String

Sub Buscar()
strDBNAME = "Base_Prueba"
Sheets("USUARIOS").Range("A13", "D100000").ClearContents
Sheets("CUENTAS").Range("A10", "AD100000").ClearContents
If validarDatos = True Then
txtcliente = Worksheets("Principal").Range("F11")
strQuery = "SELECT * FROM USUARIOS"
strQuery2 = "SELECT * FROM CLIENTES"
MsgBox "Se consultara " & strDBNAME
Call ConnectSqlServer
End If
End Sub

Private Function validarDatos() As Boolean

Dim blnValidar As Boolean
blnValidar = False
txtcliente = Worksheets("Principal").Range("F11")

'---------------------validar cliente
If txtcliente = "" Then
MsgBox "Debe Ingresar el numero de Cliente"
validarDatos = False
Exit Function
End If

validarDatos = True

End Function

Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=123456abc;" & _
"Initial Catalog=" & strDBNAME & ";" & _
"Integrated Security=SSPI;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute(strQuery)
' Check we have data.
If Not rs.EOF Then
' Transfer result
Sheets("USUARIOS").Range("A13").CopyFromRecordset rs
' Close the recordset
rs.Close
MsgBox "Finalizo la consulta de Usuarios"
Else
MsgBox "Error: No existen registros con este codigo.", vbCritical
End If
If Not rs5.EOF Then
' Transfer result
Sheets("CUENTAS").Range("C10").CopyFromRecordset rs5
' Close the recordset
rs5.Close
MsgBox "Finalizo la consulta de Cuentas"
Else
MsgBox "Error: No existen registros con este codigo.", vbCritical
End If

' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub

2 Respuestas

Respuesta

Gracias, Abraham lo probare

Respuesta
1

[Hola

En tu macro "ConnectSqlServer" debes repetir el procedimiento usado para lo de la tabla "Usuarios" solo que usando tu variable "strQuery2". Ah, obvio que también tienes que indicarle en dónde van los datos.

Abraham Valencia

Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=123456abc;" & _
"Initial Catalog=" & strDBNAME & ";" & _
"Integrated Security=SSPI;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute(strQuery)
' Check we have data.
If Not rs.EOF Then
' Transfer result
    Sheets("USUARIOS").Range("A13").CopyFromRecordset rs
' Close the recordset
    rs.Close
    MsgBox "Finalizo la consulta de Usuarios"
Else
    MsgBox "Error: No existen registros con este codigo.", vbCritical
End If
Set rs = Nothing
Set rs = conn.Execute(strQuery2)
If Not rs.EOF Then
' Transfer result
    Sheets("CUENTAS").Range("C10").CopyFromRecordset rs
' Close the recordset
    rs.Close
    MsgBox "Finalizo la consulta de Cuentas"
Else
    MsgBox "Error: No existen registros con este codigo.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub

Así debería servir, obvio tienes que revisarlo.

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas