Inserir Dados No Excel Pelo Vb

[melissa_ff]

Até consigo inserir, só que somente um registro na planilha.

Vai o codigo

Public Function relatoriosemana()

Dim xlApp As Excel.Application

Dim xlWork As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim ssql As String

Dim rela As QueryDef

Dim l As Long

'On Error GoTo GerarPlanilha

Screen.MousePointer = vbHourglass

MsgBox "Gerando relatório..."

Set xlApp = CreateObject("EXCEL.Application")

Set xlWork = xlApp.Workbooks.Open("C:\Documents and Settings\melissa\Usr\vb\AgendaDia.xls")

Set xlWork = xlApp.Workbooks(1)

Set xlSheet = xlApp.Worksheets("Dados")

Set rela = db.QueryDefs("Relatorio")

ssql = "SELECT [telefone].Data,[telefone].nome,[telefone].tel,[telefone].ligacao FROM [telefone]"

ssql = ssql & "WHERE [telefone].Data Between [Data inicial] AND [Data Final]"

Do While Not frmreladia.Data1.Recordset.EOF

With rela

.SQL = ssql

.Parameters("Data inicial") = frmreladia.cmbdia1

.Parameters("Data final") = frmreladia.cmbdia2

.Execute

xlSheet.Cells(5, 1) = Format(frmreladia.Data1.Recordset("data"), "mm/dd/yyyy")

xlSheet.Cells(5, 1).Borders.LineStyle = 3

xlSheet.Cells(5, 1).Borders.Weight = 1

xlSheet.Cells(5, 1).Font.Name = "Verdana"

xlSheet.Cells(5, 1).Font.Size = 7

xlSheet.Cells(5, 2) = frmreladia.Data1.Recordset("Nome")

xlSheet.Cells(5, 2).Borders.LineStyle = 3

xlSheet.Cells(5, 2).Borders.Weight = 1

xlSheet.Cells(5, 2).Font.Name = "Verdana"

xlSheet.Cells(5, 2).Font.Size = 7

xlSheet.Cells(5, 3) = frmreladia.Data1.Recordset("Tel")

If bCinza Then xlSheet.Cells(5, 3).Interior.ColorIndex = 15

xlSheet.Cells(5, 3).Borders.LineStyle = 3

xlSheet.Cells(5, 3).Borders.Weight = 1

xlSheet.Cells(5, 3).Font.Name = "Verdana"

xlSheet.Cells(5, 3).Font.Size = 7

xlSheet.Cells(5, 4) = frmreladia.Data1.Recordset("Ligacao")

If bCinza Then xlSheet.Cells(5, 4).Interior.ColorIndex = 15

xlSheet.Cells(5, 4).Borders.LineStyle = 3

xlSheet.Cells(5, 4).Borders.Weight = 1

xlSheet.Cells(5, 4).Font.Name = "Verdana"

xlSheet.Cells(5, 4).Font.Size = 7

End With

l = l + 1

frmreladia.Data1.Recordset.MoveNext

Loop

xlWork.Close True

xlApp.Quit

Set xlApp = Nothing

GerarPlanilha:

Select Case Err

Case 0

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox "Relatório gerado com sucesso.", vbOKOnly + vbInformation

Shell "C:\Arquivos de programas\Microsoft Office\Office\excel.exe \\melissa\Usr\vb\AgendaDia.xls"

Case 1004

Unload frmreladia

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox "O caminho não foi encontrado, por favor mude o caminho" & Chr(13) & " nas configurações e tente gerar o mapa novamente!", vbCritical + vbOKOnly

xlWork.Close True

xlApp.Quit

Set xlApp = Nothing

Case 3010

With db.TableDefs

.Delete ("asemanal")

.Refresh

End With

Case Else

MsgBox "Pronto"

Screen.MousePointer = vbNormal

MsgBox Err.Number & "-" & Err.Description, vbCritical + vbOKOnly

End Select

End Function

[Decio]

Você precisa colocar uma variavel no seu código:

Tipo assim:

Do While Not frmreladia.Data1.Recordset.EOF

xlSheet.Cells(5, x) = frmreladia.Data1.Recordset("Tel")

x = x + 1

frmreladia.Data1.Recordset.MoveNext

Loop