USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Excel para Access
mferreiraneto
LAGOA SANTA
MG - BRASIL
ENUNCIADA !
Postada em 29/04/2008 11:36 hs            
Pessoal, bom dia!
Tenho um sistema de vendas de vouchers que gera no final do dia 04 arquivos de dados referente ao dia de vendas, estes arquivos são salvos dentro de um diretório chamado BACKUP dentro de um Pendrive, veja os arquivos:

WinCarimb29-04-2008.old
WinImpRenda29-04-2008.old
WinInss29-04-2008.old
WinComissao29-04-2008.old

Bem, estes arquivos são na realidade uma planilha excel, a data na frente do arquivo refere-se ao dia de vendas, todo arquivo gerado sairá com a data atual que for gerado.

Na minha central pego este pendrive e plugo no micro, criando a unidade E:
Tenho um outro sistema que faz a importação destes dados para o Access.
Porém esta importação esta sendo através de macro.
Queria uma rotina que não utilizasse macro.
Vejam minha rotina:

Dim CpnInfo As Database
Dim Voucher As Recordset    ' Recordset do tipo Snapshot
Dim ImpRenda As Recordset   ' Recordset do tipo Snapshot
Dim Inss As Recordset       ' Recordset do tipo Snapshot
Dim Comissao As Recordset

Private Sub cmdAtualizar_Click()
On Error GoTo errado
cmdAtualizar.Enabled = False
cmdFechar.Enabled = False
Pasta_Destino.Path = "E:Backup"

Dim Resp As Byte
Resp = MsgBox("Confirma a Importação dos Dados", vbYesNo + vbQuestion, Me.Caption)
If Resp = 7 Then
cmdAtualizar.Enabled = True
cmdFechar.Enabled = True
Exit Sub
Else
cmdAtualizar.Enabled = False
cmdFechar.Enabled = False
End If

WinCarimb   'Função que renomeia o arquivo para xls
WinImpRenda 'Função que renomeia o arquivo para xls
WinInss     'Função que renomeia o arquivo para xls
WinComissao 'Função que renomeia o arquivo para xls

'-----------Importando---------------------------
Label8.Visible = True
Label8.Caption = "Aguarde, efetuando Importação dos dados..."
Label8.Refresh
MousePointer = vbHourglass ' Muda o ponteiro do mouse

Dim ac As Access.Application
Set ac = New Access.Application

'Indica o caminho do Banco de Dados e faz a conexao com as tabelas
Caminho = ReadINI("Caminho", "BD", App.Path & "Config.ini")

ac.OpenCurrentDatabase (Caminho)
ac.Visible = False
ac.DoCmd.RunMacro "Importador" 'Macro que faz a importação para o BD
MousePointer = vbDefault ' Restaura o ponteiro do mouse.

'Após a importação os arquivos xls serão deletados ficando apenas os arquivos.old
'Detalhe desta importação, os arquivos xls tem os mesmos nomes da tabela do BD e os mesmos campos
Kill ("E:BackupTblVoucherCarimbado.xls")
Kill ("E:BackupTblCadastroImpRenda.xls")
Kill ("E:BackupTblCadastroInss.xls")
Kill ("E:BackupTblCadastroComissao.xls")
'-----------Final do Backup-------------------

cmdAtualizar.Enabled = False
cmdFechar.Enabled = True
Label8.Visible = False
Label8.Refresh
MsgBox "Exportação concluida com sucesso!", vbInformation, Me.Caption
cmdFechar_Click

Exit Sub
errado:
Dim Numero_erro As String
Numero_erro = CStr(Err.Number)
If Numero_erro = "76" Or "68" Then
Call MsgBox("Não Foi Possível localizar o Diretório de Backup." _
            & vbCrLf & "Possívelmente o Pen-Drive não foi Inserido, ou" _
            & vbCrLf & "o Diretório de Backup no Pen-Drive não foi Criado!" _
            & vbNewLine & "Para saber mais consulte o Suporte." _
            , vbCritical + vbDefaultButton1, "Erro de Diretório")
cmdFechar_Click
Else
    MsgBox ("Error # " & CStr(Err.Number) & " " & Err.Description)
    Err.Clear
End If
End Sub


Private Sub cmdFechar_Click()
Unload Me
End Sub





'Funçoes para renomear os arquivos old para xls

Function WinCarimb()
Dim Diretorio As String
Diretorio = Format(Date - 1, "DD-MM-YYYY") 'DATA DO DIA ANTERIOR
Diretorio = "E:BackupWinCarimb" & Diretorio & ".old"
 
If Dir$(Diretorio) <> "" Then
FileCopy (Diretorio), ("E:BackupTblVoucherCarimbado.xls")
Else
MsgBox "Arquivo não encontrado!", vbCritical, "Mensagem"
End If
End Function


Function WinImpRenda()
Dim ImpRenda As String
ImpRenda = Format(Date - 1, "DD-MM-YYYY") 'DATA DO DIA ANTERIOR
ImpRenda = "E:BackupWinImpRenda" & ImpRenda & ".old"
 
If Dir$(ImpRenda) <> "" Then
FileCopy (ImpRenda), ("E:BackupTblCadastroImpRenda.xls")
Else
MsgBox "Arquivo não encontrado!", vbCritical, "Mensagem"
End If
End Function


Function WinInss()
Dim Inss As String
Inss = Format(Date - 1, "DD-MM-YYYY") 'DATA DO DIA ANTERIOR
Inss = "E:BackupWinInss" & Inss & ".old"
 
If Dir$(Inss) <> "" Then
FileCopy (Inss), ("E:BackupTblCadastroInss.xls")
Else
MsgBox "Arquivo não encontrado!", vbCritical, "Mensagem"
End If
End Function


Function WinComissao()
Dim Comissao As String
Comissao = Format(Date - 1, "DD-MM-YYYY") 'DATA DO DIA ANTERIOR
Comissao = "E:BackupWinComissao" & Comissao & ".old"
 
If Dir$(Comissao) <> "" Then
FileCopy (Comissao), ("E:BackupTblCadastroComissao.xls")
Else
MsgBox "Arquivo não encontrado!", vbCritical, "Mensagem"
End If
End Function



Obs:
Quero uma rotina no lugar do macro, porque o macro sempre dá pau e não faz a importação com precisão.

Alguém pode  me ajudar.

Marcelino Neto

EmoçõesMFerreira...
   
PH1959
Pontos: 2843
SÃO JOSÉ DOS CAMPOS
SP - BRASIL
ENUNCIADA !
Postada em 30/04/2008 11:25 hs            
usa uma ocx q abre o excel...
 
   
JOM
BOM JESUS DA LAPA
BA - BRASIL
ENUNCIADA !
Postada em 02/05/2008 22:21 hs            
Vc pode ler os dados da planilha no VB assim como os campos de uma tabela do Access, usando ADO, faz uma conexão com a planilha e usa um Recordset para pegar os valores depois pode implantar para importar os dados da planilha para um Banco de Dados como Access ou MySQL, seria mais ou menos assim:
 
1 - Vc cria um Form com um DriveListBox um DirListBox e um FileListBox
2 - Através dos controles citados no passo "1" vc procura onde está a planilha, no caso, Pen drive
3 - Implementa um código para quando clicar no arquivo "a planilha" este seja sua base de dados, à qual o VB irá ler através da conexão "cnn" e os dados da planilha preencherão um Recordset "rs"
4 - Dai vc pode transferir os dados desta planilha para outro BD como falei anteriormente ou trabalhar na planilha mesmo, dependendo do que queira fazer.
 
   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página