Automatizacion Excel y VB 6.0

ObjExcel.Cells(Fila + 1, 1).Select
ObjExcel.ActiveCell.EntireRow.Select
ObjExcel.Selection.Insert Shift:=xlDown <= ESTO NO LO
HACE

Saludos a

Antes que otra cosa, agradezco la atención a este mensaje.

Bueno, el problema que tengo es el siguiente, tengo aprox. 40 reportes en
excel que debo llenar con los datos de 2 tablas, digamos Clientes1 y
Clientes2.

Creo una conexion para las tablas que estan en archivos de texto plano, y
luego inserto los datos siempre y cuando el recordset no esté vacio, luego
utilizo la misma variable recordset para obtener los datos de la tabla
clientes2. como es posible que existan clientes que insertar de clientes1
y
tambien de clientes2 debo insertar una fila por cada registro insertado, y
luego calcular la fila para insertar los registros de Clientes2.

Sin embargo, creo los objetos de Excel, pero no me desplaza las filas a
pesar de que no marca ningún error, y lo peor es que tampoco me guarda los
cambios.

Aqui un poco del código

Dim Rec As Recordset
Dim ObjExcel As Object
Dim xlsLibro As Object
Dim xlsHoja As Object

Lo hice con ambos métodos despues de leer una recomendacion de Heich
'Set ObjExcel = CreateObject("Excel.Application")
Set ObjExcel = GetObject("", "Excel.Application")

'Establesco la conexion

Set Con = New ADODB.Connection
With Con
.Provider = "Microsoft.Jet.OLEDB.4.0."
.ConnectionString = "Data Source=" & Ruta & ";" & _
"Extended Properties=TEXT;"
.Open
End With

xlsAbierto = False
Grabar = False

StrSql = "Select Nombre, NAgen, Agencia, Telefono from Clientes1.Txt
where
NAgen like '" & Cod & "'"

Set Rec = Con.Execute(StrSql)
If Rec.EOF Then
GoTo Clientes2
Else
' Abrir archivo de excel segun la agencia
Set xlsLibro = ObjExcel.Workbooks.Open(Ruta & "\Final\" &
Agencia(Agen) & ".xls")
Set xlsHoja = xlsLibro.Sheets(3)
xlsAbierto = True
Fila = 9
While Not Rec.EOF

xlsHoja.Cells(Fila, 3).Value = Rec(0)
xlsHoja.Cells(Fila, 4).Value = Rec(2)
xlsHoja.Cells(Fila, 5).Value = Rec(3)

'Insertar tantas filas como registros existan en el recordset
ObjExcel.Cells(Fila + 1, 1).Select
ObjExcel.ActiveCell.EntireRow.Select
ObjExcel.Selection.Insert Shift:=xlDown <= ESTO NO LO
HACE
!!!!
'se mueve al siguiente registro del recordset
Rec.MoveNext
Fila = Fila + 1
Wend
Grabar = True
End If

Clientes2:
StrSql = ""
Select Case Agen
Case 1 To 9
Cod = "0" & CStr(Agen)
StrSql = "Select Nombre, NAgen, Agencia, Telefono from Clientes2.txt
where
NAgen like '" & Cod & "'"
Case 15, 16, 29, 38
Case Else
Cod = CStr(Agen)
StrSql = "Select Nombre, NAgen, Agencia, Telefono from Clientes2.txt
where NAgen like '" & Cod & "'"
End Select

Set Rec = Con.Execute(StrSql)
If Rec.EOF Then

GoTo Graba
Else
' Verifica si ya esta abierto el archivo de excel segun la
agencia
If xlsAbierto Then
Else
Set xlsLibro = ObjExcel.Workbooks.Open(Ruta & "\Final\" &
Agencia(Agen) & ".xls")
Set xlsHoja = xlsLibro.Sheets(3)
End If
Fila = Fila + 6
While Not Rec.EOF

xlsHoja.Cells(Fila, 3).Value = Rec(0)
xlsHoja.Cells(Fila, 4).Value = Rec(2)
xlsHoja.Cells(Fila, 5).Value = Rec(3)

'Insertar tantas filas como registros existan en el recordset
ObjExcel.Cells(Fila + 1, 1).Select
ObjExcel.ActiveCell.EntireRow.Select
ObjExcel.Selection.Insert Shift:=xlDown
'se mueve al siguiente registro del recordset
Rec.MoveNext
Fila = Fila + 1
Wend
Grabar = True
End If
Graba:

If Grabar Then
ObjExcel.ActiveWorkbook.Save Ruta & "\Final\" & Agencia(Agen) & ".xls"

<== MARCA EL ERROR 450 ´"Numero de argumentos erroneo o asignación de
propiedad no valida"

xlsLibro.Close False
Else

End If
Next Agen

ObjExcel.quit
Set ObjExcel = Nothing
Set xlsLibro = Nothing
Set xlsHoja = Nothing

Set Con = Nothing
Set Rec = Nothing

Espero que alguien pueda auxiliarme ...


César Galicia
Soporte Técnico
TNS-Gallup



César Galicia
Soporte Técnico
TNS-Gallup