Pode parecer idiotice, e é óbvio que deve ser, mas eu estou pelo VB abrindo várias planilhas excel altero o conteúdos das células o que está faltando é conseguir fechar as planilhas e salvar as alterações o que estou utilizando é:
Private Sub Command1_Click()
Dim Dt As Date
Dim Dt1 As Date
Dim arq1 As String
Dim Excel As Object
Set Excel = CreateObject("Excel.Application.8")
If DtIni.Text = "__/____" Then
Dt = Date - Day(Date)
Dt = Dt + 1
Else
Dt = CDate("01/" & DtIni.Text)
End If
Dt1 = Dt + 32
Dt1 = Dt1 - Day(Dt1)
Dim rs_temp As Recordset
Set rs_temp = Base_Relato.OpenRecordset("Conteudo")
rs_temp.MoveMin
On Error GoTo criar_arquivo
Do While Not rs_temp.EOF
arq1 = "X:MdbsPontuacao" & rs_temp("Texto1") & ".xls"
FileCopy arq1, "X:MdbsPontuacao este.xls"
rs_temp.MoveNext
Loop
Kill "X:MdbsPontuacao este.xls"
Base_Relato.Execute "INSERT INTO Conteudo1 ( Valor1, Valor2 ) " & _
"SELECT Pedidos.Cod_Repres, Sum(Pedidos.Tot_Pedido) AS SomaDeTot_Pedido " & _
"FROM [" & Base_Pedido_P.Name & "].Pedidos INNER JOIN [" & Base_Pedido_P.Name & "].Tipo_Pedido ON Pedidos.Tipo_Pedido = Tipo_Pedido.Cod_Tipo " & _
"WHERE (((Tipo_Pedido.Acumula_Vendas)=True) AND ((Pedidos.Emissao_NF) Between " & G_Sqldata((Dt)) & " And " & G_Sqldata((Dt1)) & ")) " & _
"GROUP BY Pedidos.Cod_Repres;"
Base_Relato.Execute "UPDATE Conteudo INNER JOIN Conteudo1 ON Conteudo.Valor1 = Conteudo1.Valor1 SET Conteudo.Valor2 = [Conteudo1]![Valor2];"
Base_Relato.Execute "DELETE Conteudo1.* FROM Conteudo1;"
Base_Relato.Execute "INSERT INTO Conteudo1 ( Valor1, Valor2 ) " & _
"SELECT Pedidos.Cod_Repres, Sum(Pedidos.Tot_Pedido) AS SomaDeTot_Pedido " & _
"FROM [" & Base_Pedido_P.Name & "].Pedidos INNER JOIN [" & Base_Pedido_P.Name & "].Tipo_Pedido ON Pedidos.Tipo_Pedido = Tipo_Pedido.Cod_Tipo " & _
"WHERE (((Tipo_Pedido.Baixa_Venda)=True) AND ((Pedidos.Emissao_NF) Between " & G_Sqldata((Dt)) & " And " & G_Sqldata((Dt1)) & ")) " & _
"GROUP BY Pedidos.Cod_Repres;"
Base_Relato.Execute "UPDATE Conteudo INNER JOIN Conteudo1 ON Conteudo.Valor1 = Conteudo1.Valor1 SET Conteudo.Valor2 = [Conteudo]![Valor2]-[Conteudo1]![Valor2];"
Set rs_temp = Base_Relato.OpenRecordset("Conteudo")
rs_temp.MoveMin
On Error Resume Next
Do While Not rs_temp.EOF
Set Excel = CreateObject("Excel.Application.8")
With Excel
.Workbooks.Open FileName:="X:MdbsPontuacao" & rs_temp("Texto1") & ".xls"
.Sheets("Vendas Mensais").Select
Select Case Month(Dt)
Case 1
.Range("C4").Select
Case 2
.Range("E4").Select
Case 3
.Range("G4").Select
Case 4
.Range("I4").Select
Case 5
.Range("K4").Select
Case 6
.Range("M4").Select
Case 7
.Range("O4").Select
Case 8
.Range("Q4").Select
Case 9
.Range("S4").Select
Case 10
.Range("U4").Select
Case 11
.Range("W4").Select
Case 12
.Range("Y4").Select
End Select
.activecell.Value = rs_temp("Valor2")
End With
Set Excel = Nothing
rs_temp.MoveNext
Loop
Exit Sub
criar_arquivo:
FileCopy "X:MdbsPontuacaosimulador_campanha.xls", arq1
Resume Next
End Sub
