Usava no tempo do Clipper.
A princípio é definir comandos SQL e ela faz o resto.
Só que, apesar do fonte ser em Clipper, ele gera um arquivo VBS.
Pra esse arquivo VBS funcionar, precisa instalar o cliente ADS.
As planilhas geradas usam os nomes dos campos retornados pelas consultas, totaliza os campos numéricos, e formata.
VBS = Visual Basic for Script, é executado através do Wscript.exe, que faz parte do Windows.
ADS = cliente ODBC Advantage Database Server, pra acessar DBFs por ADO/Comandos SQL localmente não precisa servidor
Não sei por quanto tempo vou manter esse fonte, porque atualmente não deixo vinculado a Excel, e nem me preocupo em formatar.
Recapitulando:
Seus DBFs em formato DBFCDX, comando SQL com o que quiser dos seus arquivos DBFs, precisa instalar odbc do ADS pra usar ADS local.
Algo como: DBF2Excel( "SELECT CODIGO, CLIENTE.NOME AS NOME, SUM(VALOR) AS SOMA FROM FINANCEIRO " + ;
"INNER JOIN CLIENTES ON FINANCEIRO.CODIGO = CLIENTES.CODIGO " + ;
"GROUP BY CODIGO ORDER BY NOME" )
O Clipper só gera o script. É o script que pesquisa os documentos em financeiro.dbf, totaliza por cliente, pega o nome de cada cliente em clientes.dbf, coloca em ordem alfabética, e depois gera a planilha.
Olhando o fonte, criei isso em 2004, 11 anos atrás.
Há 11 anos atrás, usando Clipper, usava DBFs através de comandos SQL... vai entender.
O fonte é mistura de fonte Clipper, fonte VBS, uso de ADO, uso de ADS, uso de SQL, e uso do objeto Excel numa coisa só.
Mantive isso no aplicativo, só atualizando pra compilar no Harbour, mas fora de uso.
Postei completo, incluindo as anotações da época, de alguns testes.
Código: Selecionar todos
FUNCTION Dbf2Excel1(cSql,cPath)
LOCAL mTmpFile, nCont
cPath := Iif( cPath == NIL, hb_cwd(), cPath )
mTmpFile := MyTempFile( "VBS" )
SET ALTERNATE TO (mTmpFile)
SET ALTERNATE ON
SET CONSOLE OFF
? [Dim cSqlList(]+LTrim(Str(Len(cSql)-1))+[)]
For nCont = 1 to Len(cSql)
? [ cSqlList(] + LTrim(Str(nCont-1)) + [) = "] + cSql[nCont] + ["]
NEXT
Text
Dim ObjExcel ' Workbook do Excel
Dim DbConn ' Conexao com Banco
Dim Rs ' RecordSet
Dim nQtdDoc ' Qtde Documentos
Dim nRecCount ' Qtde Registros
Dim nFldCount ' Qtde Campos
Dim cSql ' Auxiliar com Comando Sql
Dim cThisRange ' Auxiliar com "Range" do Excel
' Cria objeto do Excel
Set ObjExcel = WScript.CREATEObject("Excel.Application")
ObjExcel.Visible = True
' Cria conexao com Banco
Set DbConn = CREATEObject("ADODB.Connection")
DbConn.Open "Provider=Advantage.OLEDB.1;" & _
"Mode=Share Deny None;" & _
"Show Deleted Records in DBF Tables WITH Advantage=False;" & _
EndText
? [ "Data Source=] + cPath + [;Advantage Server Type=ADS_Local_Server;" & _]
Text
"TableType=ADS_CDX;Security Mode=ADS_IGNORERIGHTS;" & _
"Lock Mode=Compatible;" & _
"Use NULL values in DBF Tables WITH Advantage=True;" & _
"Exclusive=No;Deleted=No;"
' Modifica data
' Cria Workbook no Excel, e torna-o ativo
ObjExcel.Workbooks.add
ObjExcel.Workbooks(1).Activate
For Each cSql in cSqlList
' Cria nova planilha, ou seta ja' existente
nQtdDoc = nQtdDoc + 1
IF nQtdDoc > ObjExcel.Workbooks(1).Worksheets.Count Then
ObjExcel.Workbooks(1).Worksheets.Add
ELSE
ObjExcel.Workbooks(1).Worksheets(nQtdDoc).Select
End If
' Executa comando SQL
Set Rs = DbConn.Execute( cSql )
' Coloca como titulo o nome dos campos e calcula qtd.campos
nFldCount = 1
For Each cFld in Rs.Fields
ObjExcel.Cells(3,nFldCount).Value = UCase(cFld.Name)
nFldCount = nFldCount + 1
NEXT
EndText
Text
' Coloca conteudo dos campos nas celulas
nRecCount = 1
Rs.MoveFirst
DO WHILE Not Rs.Eof
nFldCount = 1
For Each cFld in Rs.Fields
cCampo = "" & Rs.Fields(cFld.Name).Value
cCampo = REPLACE(cCampo,",",".")
' IF IsDate(cCampo) Then
' cCampo = Format(cCampo,"YYYY-MM-DD")
' ENDIF
ObjExcel.Cells(nRecCount+4,nFldCount).Value = "" & LTrim(cCampo)
nFldCount = nFldCount + 1
NEXT
nRecCount = nRecCount + 1
Rs.MoveNEXT
LOOP
' Somatoria
nFldCount = 1
For Each cFld in Rs.Fields
ObjExcel.Cells(nRecCount+5,nFldCount).Value = "=SUM(" & Chr(64+nFldCount) & "5:" & Chr(64+nFldCount) & nRecCount+4 & ")"
nFldCount = nFldCount+1
NEXT
Rs.Close
Set Rs = Nothing
EndText
Text
' Formatacao
ObjExcel.Range("A1:" & Chr(64+nFldCount) & nRecCount+5 ).AutoFormat True
' Destaque Titulos
cThisRange = "A3:" & Chr(64+nFldCount) & "3"
ObjExcel.Range(cThisRange).Font.Bold = True
' ObjExcel.Range(cThisRange).Interior.ColorIndex = 1
' ObjExcel.Range(cThisRange).Interior.Pattern = 1
' ObjExcel.Range(cThisRange).Font.ColorIndex = 2
' Destaque Totais
cThisRange = "A" & nRecCount+5 & ":" & Chr(64+nFldCount) & nRecCount+5
ObjExcel.Range(cThisRange).Font.Bold = True
' ObjExcel.Range(cThisRange).Interior.ColorIndex = 1
' ObjExcel.Range(cThisRange).Interior.Pattern = 2
' ObjExcel.Range(cThisRange).Font.ColorIndex = 2
ObjExcel.Cells(1,1) = "PLANILHA"
ObjExcel.Range("A1").Font.Bold = True
ObjExcel.Range("A1:" & Chr(64+nFldCount) & "1").MergeCells = True
NEXT
' Desativa Conexao
IF DbConn.State = 2 Then
DbConn.Close
End If
Set DBConn = Nothing
EndText
Text
'ObjExcel.Columns("B:B").Select
'ObjExcel.Selection.HorizontalAlignment = &hFFFFEFDD ' xlLeft
ObjExcel.Visible = True
'ObjExcel.WorkBooks(1).SaveAs "teste"
'ObjExcel.Quit
Set ObjExcel = Nothing
MsgBox("Geracao Concluida!")
EndText
SET CONSOLE ON
SET ALTERNATE OFF
SET ALTERNATE TO
RunCmd( "WScript " + mTmpFile )
RETURN mTmpFile
