Ir ao conteúdo
  • Cadastre-se

[ADO] Outlook → BD do Access


tonn3r

Posts recomendados

Montei o código de DAO para lançar registros no Access, de acordo com anexos que chegam pelo outlook.

Mas ele funcionou apenas uma vez, e nunca mais.

Já conferi linha por linha, li mil tutoriais. Está tudo certo.

Copiei o código para o Excel e funciona perfeitamente. Só no Outlook que não.

As referências estão Ok, o VBA não retorna erro nenhum...

Simplesmente ele não executa a parte do código que coloquei em vermelho.

Onde eu estou errando, pelamordedeus? :confused:


Módulo de Classe: ClasseConexao

Public Conn As New ADODB.Connection
Public Sub Conectar()
Dim nConectar As String
Dim PastaArq As String
Dim CaminhoArq As String

'local do banco de dados
PastaArq = "C:\Users\37365\Desktop\"
If (Right(PastaArq, 1) <> "\") Then
PastaArq = PastaArq & "\"
End If

'Local e nome do banco de dados
CaminhoArq = PastaArq & "base.accdb"

nConectar = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CaminhoArq
Conn.ConnectionString = nConectar
Conn.Open
End Sub

Public Sub Desconectar()
Conn.Close
End Sub



ThisOutlookSession:

Public Sub SalvarAnexo(Item As MailItem)

Dim Atmt As Attachment
Dim FileName As String

'verificar extensao do anexo
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 4) = "xlsm" Then
FileName = "C:\temp\" & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
End If

If Right(Atmt.FileName, 4) = "xlsx" Then
FileName = "C:\temp\" & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
End If

If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\temp\" & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
End If

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.DisplayAlerts = False
xlApp.Workbooks.Open (FileName)
Dim xlSht As Excel.Worksheet
Set xlSht = xlApp.Sheets(1)
Dim xlRng As Excel.Range
Set xlRng = xlSht.Cells(1, 8)

Dim ndia As String
Dim nsetor As String
Dim nnome As String
Dim ndestino As String
Dim nsaida As String
Dim nretorno As String
Dim ndetalhes As String
Dim cadem As String
Dim cadpor As String
Dim rFirst As Long
Dim rLast As Long
Dim x As Integer


'verificar se o arquivo contem o codigo verificador
Select Case xlSht.Cells(1, 8).Value
Case "se2213evertonmonteiro"

'definir a primeira e a ultima linhas que contém registros na planilha
rLast = xlSht.Cells(Rows.Count, "A").End(xlUp).Row

If xlSht.Cells(466, 2).Value = 0 Then
rFirst = "384"
Else
rFirst = "467"
End If

'executar a ação X a cada registro da planilha
For x = rFirst To rLast
ndia = xlSht.Cells(x, "A").Value
nsetor = xlSht.Cells(x, "B").Value
nnome = xlSht.Cells(x, "D").Value
ndestino = xlSht.Cells(x, "E").Value
nsaida = xlSht.Cells(x, "F").Value
nsaida = Format(nsaida, "hh:nn")
nretorno = xlSht.Cells(x, "G").Value
nretorno = Format(nretorno, "hh:nn")
ndetalhes = xlSht.Cells(x, "H").Value
cadem = Item.ReceivedTime
cadpor = Item.SenderName


'chamar a Classe Conexao
Dim cx As New ClasseConexao
'VARIÁVEL DE ARMAZENAMENTO DOS DADOS DO BANCO
Dim banco As ADODB.Recordset
'VARIÁVEL DE COMANDO PARA INSERIR OD DADOS
Dim sql As String

'DEFININDO INSTRUÇÃO A VARIÁVEL
sql = "INSERT INTO [atendimentos]( dia, nome, setor, prev_saida, prev_retorno, detalhes)"
sql = sql & " VALUES ( "
sql = sql & "#" & ndia & "#, "
sql = sql & "'" & nnome & "', "
sql = sql & "'" & nsetor & "', " 'INSERT INTO , INSTRUÇÃO SQL PARA INSERIR DADOS
sql = sql & "#" & nsaida & "#, "
sql = sql & "#" & nretorno & "#, "
sql = sql & "'" & ndetalhes & "')"



MsgBox sql [COLOR="YellowGreen"]'EXCLUIR - serve apenas para eu verificar se a SQL está correta[/COLOR]
Set banco = New ADODB.Recordset
'CONECTAR AO BANCO DE DADOS
MsgBox "banco setado" [COLOR="YellowGreen"]'EXCLUIR as msgboxes! elas servem apenas para eu descobrir em que parte o codigo pára[/COLOR]
cx.Conectar
'EXECUTAR A SQL
MsgBox "conectado" 'EXCLUIR msgbox

[COLOR="Red"] [B]banco.Open sql, cx.Conn[/B]
MsgBox "executado" 'EXCLUIR msgbox


'DESCONECTAR PARA LIBERAR MEMÓRIA
cx.Desconectar
MsgBox "desconectado!" 'EXCLUIR msgbox


MsgBox "proximo" 'EXCLUIR
Next x



MsgBox "Ok!" 'EXCLUIR msgbox

Case Else
Exit Sub
End Select


Next Atmt[/COLOR]

End Sub

Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...