Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Access
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.09.2017, 08:16   #1
Aleksey_25
 
Регистрация: 18.07.2017
Сообщений: 5
По умолчанию Макрос в VBA, что бы Outlook периодически самостоятельно новые поступающие письма сохранял в БД Access

Всем доброго дня.
Есть учетная запись в Outlook 2010.
Необходимо сделать следующее: при поступлении новых писем на почту, Outlook периодически должен сохранять данные сообщения в БД Access и вложения (если они есть) в определенную папку при этом записав в БД путь к данному файлу.

Подскажите как решить данную задачу, и если можно с примером кода.
Aleksey_25 вне форума Ответить с цитированием
Старый 22.09.2017, 17:14   #2
Aleksey_25
 
Регистрация: 18.07.2017
Сообщений: 5
По умолчанию

кто ни будь знает как написать данный макрос?
Aleksey_25 вне форума Ответить с цитированием
Старый 22.09.2017, 22:00   #3
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Начните с https://www.pcreview.co.uk/threads/p...ccess.2540547/
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 23.09.2017, 13:57   #4
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
У меня та же проблема
Если не трудно можете подсказать на примере?

Последний раз редактировалось Margenal; 23.09.2017 в 20:21.
Margenal вне форума Ответить с цитированием
Старый 24.09.2017, 14:03   #5
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

пытаюсь написать в VBA макрос для автоматической записи поступающих писем в БД Access.

при запуске макроса происходит подсветка Sub LOG() и на Private WithEvents myOlItems As Outlook.Items

Код:
'LOG - имя макроса
Sub LOG()
Private WithEvents myOlItems  As Outlook.Items
 
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
      Set olApp = Outlook.Application
      Set objNS = olApp.GetNamespace("MAPI")
      Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
 
Private Sub myOlItems_ItemAdd(ByVal item As Object)
 
On Error GoTo ErrorHandler
 
  Dim Msg As Outlook.MailItem
  Dim objAtt As Outlook.Attachment
  Dim iBody, iAttachments, iRecipients As String
 
  If TypeName(item) = "MailItem" Then
    Set Msg = item
    ' Debug.Print Msg.Subject
   
    Dim q As Integer
    'Dim iRecipients, iAttachments As String
    With Msg
     If .Recipients.Count > 0 Then
      For q = 1 To .Recipients.Count
       iRecipients = .Recipients.item(q).Name & "; " & iRecipients
      Next q
     End If
    End With
    
    With Msg
    If .Attachments.Count > 0 Then
     For q = 1 To .Attachments.Count
      Set objAtt = .Attachments(q)
      iAttachments = objAtt.FileName & " | " & iAttachments
     Next q
    End If
    End With
    
    iBody = Replace(RemoveHTML(Msg.Body), "'", "`")
 
    Dim conn As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    Dim stm As ADODB.Stream
 
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\test.accdb;Persist Security Info=False"
    
    conn.Execute "INSERT INTO ImportOutlook " & _
    " (Subject, Body, Recipients,  " & _
    " SenderName, Recieved, FilesCount, Attachments, N)" & _
    " VALUES ('" & Msg.Subject & "' , '" & iBody & "', '" & iRecipients & "', " & _
    "'" & Msg.SenderName & "', '" & Msg.CreationTime & "', '" & Msg.Attachments.Count & "',  '" & iAttachments & "',  '" & Msg.EntryID & "')"
    
    conn.Close
    
        ' attachments (files)
        Dim MyDateID
        MyDateID = Msg.EntryID
        DestFolder = "D:\AutoEmails2\"
        'For Each Msg In myFolder.Items.Restrict("[Unread]=TRUE")
        If Msg.Attachments.Count > 0 Then
            If Len(Dir(DestFolder & MyDateID, vbDirectory)) = 0 Then
                   MkDir DestFolder & MyDateID
            End If
            For j = 1 To Msg.Attachments.Count
             Msg.Attachments.item(j).SaveAsFile DestFolder & "\" & MyDateID & "\" & Msg.Attachments.item(j).DisplayName
             
            Next j
        End If
        ' mi.UnRead = False
        'Next
        
  End If
 
 
ProgramExit:
  Exit Sub
ErrorHandler:
  Debug.Print Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub
 
Function RemoveHTML(sString As String) As String
 'MsgBox RemoveHTML("<html><b>And</b><!-- some comment --> <p>then<br/> some</p></html>")
    On Error GoTo Error_Handler
    Dim oRegEx          As Object
 
    Set oRegEx = CreateObject("vbscript.regexp")
 
    With oRegEx
        '.Pattern = "<[^>]+>"    'basic html pattern
        .Pattern = "<!*[^<>]*>"    'html tags and comments
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
    End With
 
    RemoveHTML = oRegEx.Replace(sString, "")
 
Error_Handler_Exit:
    On Error Resume Next
    Set oRegEx = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: RemoveHTML" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function
 
 
End Function
может кто нибудь подсказать что делаю не так?
Margenal вне форума Ответить с цитированием
Старый 24.09.2017, 14:33   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Попробуйте удалить строки sub log(), end function
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Пересылка входящего письма VBA Outlook Екатерина Попкова Microsoft Office Excel 1 26.04.2015 22:42
Microsoft Outlook 2010 VBA: Получение Письма Odinok Microsoft Office Excel 5 03.09.2014 20:37
Макрос для outlook проверка текста письма!!! Ania Shepeleva Microsoft Office Word 1 30.03.2014 16:26
VBA Создания письма с атачами из MS Outlook mrMad-Cat Microsoft Office Excel 3 24.04.2012 11:54
Форматирование письма OUTLOOK'а oTyler Microsoft Office Excel 0 28.07.2008 14:49