Microsoft Excel

Herbers Excel/VBA-Archiv

Outlook MAkro nach Zeit starten


Betrifft: Outlook MAkro nach Zeit starten
von: Anette
Geschrieben am: 03.02.2010 14:55:36

Hallo zusammen,

ich möchte in Outlook ein Makro zu einer bestimmten Zeit starten. In Excel regle ich das mit folgendem Satz:

Application.OnTime Now + TimeSerial(1, 0, 0), "meinMakro"

Leider geht dieser Code nicht in Outlook.
Kann mir jemand weiterhlefen?

  

Betrifft: AW: Outlook MAkro nach Zeit starten
von: Renee
Geschrieben am: 03.02.2010 15:51:31

Hi Anette,

Diese Methode gibt es nicht in Outlook.
Auswege wären: Timer - DoEvents - Loop until - Code ausführen.
...oder das Ganze über ein VBScript.
Leider ist das hier ein EXCEL und kein OUTLOOK Forum. Vielleicht kann dir jemand in einem letzteren weiterhelfen.

GreetZ Renée


  

Betrifft: AW: Outlook MAkro nach Zeit starten
von: Renee
Geschrieben am: 03.02.2010 15:51:32

Hi Anette,

Diese Methode gibt es nicht in Outlook.
Auswege wären: Timer - DoEvents - Loop until - Code ausführen.
...oder das Ganze über ein VBScript.
Leider ist das hier ein EXCEL und kein OUTLOOK Forum. Vielleicht kann dir jemand in einem letzteren weiterhelfen.

GreetZ Renée


  

Betrifft: AW: Outlook MAkro nach Zeit starten
von: Anette
Geschrieben am: 03.02.2010 18:23:10

Hi Renée,

danke für Deinen Tipp. Leider bin nicht all zu erfahren im Programmieren.

Wie könnte denn ein Beispiel zu

"Timer - DoEvents - Loop until - Code"


aussehen?


  

Betrifft: AW: Outlook MAkro nach Zeit starten
von: Josef Ehrensberger
Geschrieben am: 03.02.2010 21:10:32

Hallo Anette,


hab die mal was gebalstelt, vielleicht hilft es dir.

Die Klassenmodule musst du wie im angehängten Code benennen, als 1x APITimer und 1x clsInit.


' **********************************************************************
' Modul: ThisOutlookSession
' **********************************************************************

Option Explicit

Private Sub Application_Startup()
  initTimer
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public newTimer As clsInit

Public Sub initTimer()
  Set newTimer = New clsInit
  newTimer.create
  newTimer.Timer1.IntervalMS = 10000 'alle 10 Sekunden wird gecheckt!
  newTimer.Timer1.Enabled = True
End Sub

Public Sub deinMakro()
  MsgBox "Hallo"
End Sub

' **********************************************************************
' Modul: clsInit Typ: Klassenmodul
' **********************************************************************

Option Explicit

Public WithEvents Timer1 As APITimer

Private bAction As Boolean

Public Sub create()
  Set Timer1 = New APITimer
  bAction = True
End Sub

Private Sub Class_Terminate()
  Me.Timer1.Enabled = False
End Sub

Private Sub Timer1_Tick()
  'zu jeder vollen Stunde
  'If bAction Then
  ' If Minute(Now) = 0 Then
  ' bAction = False
  ' Call deinMakro
  ' Else
  ' bAction = True
  ' End If
  'End If
  
  'zu bestimmter Uhrzeit, Beispiel 09:45
  If bAction Then
    If TimeSerial(Hour(Now), Minute(Now), 0) = TimeSerial(9, 45, 0) Then
      bAction = False
      Call deinMakro
    Else
      bAction = True
    End If
  End If
End Sub

' **********************************************************************
' Modul: APITimer Typ: Klassenmodul
' **********************************************************************

'Code der Klasse "APITimer"

Option Explicit


' benötigte API-Deklarationen
Private Declare Function SetTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIdEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal uIDEvent As Long) As Long

Private Declare Sub CopyMem Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  pDst As Any, _
  pSrc As Any, _
  ByVal cb As Long)

Private Declare Function VirtualAlloc Lib "kernel32" ( _
  lpAddress As Any, _
  ByVal dwSize As Long, _
  ByVal flAllocationType As Long, _
  ByVal flProtect As Long) As Long

Private Const MEM_COMMIT As Long = &H1000&

Private Declare Function VirtualFree Lib "kernel32" ( _
  lpAddress As Any, _
  ByVal dwSize As Long, _
  ByVal dwFreeType As Long) As Long

Private Const MEM_DECOMMIT As Long = &H4000&

Private Const PAGE_EXECUTE As Long = &H10&
Private Const PAGE_EXECUTE_READ As Long = &H20&
Private Const PAGE_EXECUTE_READWRITE As Long = &H40&

Private Const ASM_SIZE As Long = &HFF&

Private m_ptrCallback As Long
Private m_hdlTimer As Long
Private m_blnEnabled As Boolean
Private m_lngInterval As Long

Public Event Tick()

' muss erste öffentliche Methode in Interface sein!
' API Timer wird diese Methode aufrufen
Public Sub TimerCallback( _
    ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal idEvent As Long, ByVal dwTime As Long)

  
  RaiseEvent Tick
End Sub

' Aktiviert/Deaktiviert Timer (vgl. VB Intrinsic)
Public Property Get Enabled() As Boolean
  Enabled = m_blnEnabled
End Property

Public Property Let Enabled(ByVal blnValue As Boolean)
  If blnValue <> m_blnEnabled Then
    If blnValue Then
      m_hdlTimer = SetTimer(0, 0, IntervalMS, m_ptrCallback)
    Else
      KillTimer 0, m_hdlTimer
    End If
    m_blnEnabled = blnValue
  End If
End Property

' Bestimmt Interval, in dem Tick Event gefeuert wird
' (in Millisekunden)
Public Property Get IntervalMS() As Long
  IntervalMS = m_lngInterval
End Property

Public Property Let IntervalMS(ByVal lngMs As Long)
  m_lngInterval = lngMs
  
  If Enabled Then
    ' wird Interval geändert während Timer aktiv ist,
    ' muss er neu initialisiert werden
    Enabled = False
    Enabled = True
  End If
End Property

' Adresse erster öffentlicher Methode eines COM Interfaces ermitteln
Private Function GetFirstPublicMethod(ByVal obj As Object) As Long
  Dim pObj As Long
  Dim pVtbl As Long
  
  ' Adresse über VTable des Interfaces (IUnknown und IDispatch
  ' dort zuerst eingetragen, daher 7 Einträge = &H1C Bytes überspringen)
  CopyMem pObj, ByVal ObjPtr(obj), 4
  CopyMem pVtbl, ByVal pObj + &H1C, 4
  
  GetFirstPublicMethod = pVtbl
End Function

' Für ASM Callback genutzten Speicher freigeben
Private Sub FreeCallback(ByVal ptr As Long)
  VirtualFree ByVal ptr, ASM_SIZE, MEM_DECOMMIT
End Sub

' ASM Callback erstellen, das Timercallbacks an eine
' Methode der Klasse weiterleitet
Private Function CreateCallback(ByVal obj As Object, _
    ByVal addr As Long, ByVal params As Long) As Long

  
  Dim ptrMem As Long
  Dim ptrItr As Long
  Dim ptrNewAddr As Long
  Dim i As Long
  Dim j As Long
  
  ' ausführbaren Speicher vom System holen
  ' und Maschinencode reinschreiben
  ptrMem = VirtualAlloc(ByVal 0&, ASM_SIZE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
  If ptrMem = 0 Then
    Err.Raise 12345, , "VirtualAlloc fehlgeschlagen!"
  End If
  
  ptrItr = ptrMem
  
  For i = 1 To params
    CopyMem ByVal ptrItr + 0, &H2474FF, 3 ' PUSH [ESP+imm8]
    CopyMem ByVal ptrItr + 3, params * 4, 1
    ptrItr = ptrItr + 4
  Next
  
  CopyMem ByVal ptrItr + 0, &H68, 1 ' PUSH imm32
  CopyMem ByVal ptrItr + 1, ObjPtr(obj), 4
  ptrItr = ptrItr + 5
  
  ptrNewAddr = addr - ptrItr - 5
  
  CopyMem ByVal ptrItr + 0, &HE8, 1 ' CALL rel32
  CopyMem ByVal ptrItr + 1, ptrNewAddr, 4
  ptrItr = ptrItr + 5
  
  CopyMem ByVal ptrItr + 0, &HC2, 1 ' RET imm16
  CopyMem ByVal ptrItr + 1, params * 4, 2
  
  CreateCallback = ptrMem
End Function

Private Sub Class_Initialize()
  m_ptrCallback = CreateCallback(Me, GetFirstPublicMethod(Me), 4)
End Sub

Private Sub Class_Terminate()
  If Enabled Then Enabled = False
  FreeCallback m_ptrCallback
End Sub


Gruß Sepp



  

Betrifft: Danke Sepp, ich hab es schon...
von: Renee
Geschrieben am: 03.02.2010 21:45:22

mit der Angst zu tun bekommen, dass ich was zusammensticken müsste ;-)
Na ja, manchmal täte es mir gut den Mund nicht so weit aufzumachen.

GreetZ Renée


  

Betrifft: AW: Danke Sepp, ich hab es schon...
von: Josef Ehrensberger
Geschrieben am: 03.02.2010 22:00:22

Hi Renée,


meine Sorge das du das nicht hinbekommen hättest, hält sich in Grenzen;-))

Mit Outlook-VBA hab ich sonst auch nicht allzuviel am Hut, aber ich dachte ich probier's einfach mal, werden ja sehen ob es Anette hilft.

Bis denne,



Gruß Sepp



  

Betrifft: AW: Danke Sepp, ich hab es schon...
von: Anette
Geschrieben am: 04.02.2010 14:36:53

Lieber Sepp,

danke für Deine Hilfe!
Mal sehen ob ich damit zurechtkomme.
Dass das so kompliziert werden wird, habe ich nicht erwartet....


  

Betrifft: kleine aber wichtige anpassung
von: Josef Ehrensberger
Geschrieben am: 04.02.2010 14:13:53

Hallo Anette,


ersetze den Code der angegebenen Module, das Klassenmodul APITimner bleibt wie es ist.



' **********************************************************************
' Modul: ThisOutlookSession
' **********************************************************************

Option Explicit

Private Sub Application_Quit()
  destroyTimer
End Sub

Private Sub Application_Startup()
  initTimer
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public newTimer As clsInit

Public Sub initTimer()
  Set newTimer = New clsInit
  newTimer.create
  newTimer.Timer1.IntervalMS = 10000 'alle 10 Sekunden wird gecheckt!
  newTimer.Timer1.Enabled = True
End Sub

Public Sub deinMakro()
  MsgBox "Hallo"
End Sub

Public Sub destroyTimer()
  If Not newTimer Is Nothing Then newTimer.destroy
End Sub

' **********************************************************************
' Modul: clsInit Typ: Klassenmodul
' **********************************************************************

Option Explicit

Public WithEvents Timer1 As APITimer

Private bAction As Boolean

Public Sub create()
  Set Timer1 = New APITimer
  bAction = True
End Sub

Public Sub destroy()
  Class_Terminate
End Sub
Private Sub Class_Terminate()
  Me.Timer1.Enabled = False
End Sub

Private Sub Timer1_Tick()
  'zu jeder vollen Stunde
  
  'If Minute(Now) = 0 Then
  ' If bAction Then
  ' bAction = False
  ' Call deinMakro
  ' End If
  'Else
  ' bAction = True
  'End If
  
  'zu bestimmter Uhrzeit, Beispiel 09:45
  
  If TimeSerial(Hour(Now), Minute(Now), 0) = TimeSerial(9, 45, 0) Then
    If bAction Then
      bAction = False
      Call deinMakro
    End If
  Else
    bAction = True
  End If
  
End Sub


Gruß Sepp



  

Betrifft: AW: kleine aber wichtige anpassung
von: Anette
Geschrieben am: 04.02.2010 16:58:20

Es funktioniert!

Danke vielmals,

Gruß Anette