Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Einfügen in neuem Tabellenblatt | Herbers Excel-Forum


Betrifft: Einfügen in neuem Tabellenblatt von: Space
Geschrieben am: 19.01.2010 14:01:44

Hallo,

ich habe folgendes Problem. Über einen Button auf dem Tabellenblatt1 will ich das Tabellenblatt 3 (Outlook Kontakte) öffnen und die Outlook entnommenen Kontakte dort eintragen lassen. Der Zugriff auf Outlook funktioniert wunderbar. Die Werte die er dort heraus bekommt trägt er aber in Tabellenblatt1 (Menu) anstatt ins Tabellenblatt3 (Outlook Kontakte) ein.

Kann mir jemand weiterhelfen? Hier mein Code:

Private Sub CommandButton13_Click()

'Excel-Sheet "Outlook Kontakte" öffnen
Sheets("Outlook Kontakte").Select

'Deklaration
 Dim outApp As Object
 Dim outNameSpace As Object
 Dim outMapiFolder As Object
 Dim outAllItems As Object
 Dim outRealItems As Object
 Dim outContactItem As Object
 Dim strContactFilter As String
 Dim Zeile As Integer
 Zeile = 14
 
 'Outlook-Objekte öffnen
 Set outApp = CreateObject("Outlook.Application")
 Set outNameSpace = outApp.GetNamespace("MAPI")
 Set outMapiFolder = outNameSpace.GetDefaultFolder(10)
 Set outAllItems = outMapiFolder.Items
 
 'Verteilerlisten herausfiltern,'nur 'Richtige Kontakte' verwenden
 strContactFilter = "[MessageClass] = 'IPM.Contact'"
 Set outRealItems = outAllItems.Restrict(strContactFilter)
    
'Outlook-Kontakte ins Excel Tabellenblatt "Outlook-Kontakte" übertragen
For Each outContactItem In outRealItems
Cells(Zeile, 1).Value = outContactItem.Title
Cells(Zeile, 2).Value = outContactItem.FirstName
Cells(Zeile, 3).Value = outContactItem.LastName
Cells(Zeile, 4).Value = outContactItem.JobTitle
Cells(Zeile, 5).Value = outContactItem.Department
Cells(Zeile, 6).Value = outContactItem.CompanyName
        
Cells(Zeile, 8).Value = outContactItem.BusinessAddressStreet
Cells(Zeile, 9).Value = outContactItem.BusinessAddressPostalCode
Cells(Zeile, 10).Value = outContactItem.BusinessAddressCity
Cells(Zeile, 11).Value = outContactItem.BusinessAddressCountry
Cells(Zeile, 12).Value = outContactItem.BusinessTelephoneNumber
Cells(Zeile, 14).Value = outContactItem.HomeTelephoneNumber
Cells(Zeile, 15).Value = outContactItem.Email1Address
        
Cells(Zeile, 17).Value = outContactItem.WebPage
Zeile = Zeile + 1
         
Next outContactItem

MsgBox ("Die Datensätze wurden in das Tabellenblatt Outlook-Kontakte übertragen") 'MessageBox    _
_
_
anzeigen

'Speicher freigeben
Set outRealItems = Nothing
Set outAllItems = Nothing
Set outMapiFolder = Nothing
Set outNameSpace = Nothing
Set outApp = Nothing
    
End Sub

Vielen Dank!
Gruß
Space

  

Betrifft: Menu ist aktiv! von: Rudi Maintaire
Geschrieben am: 19.01.2010 14:06:41

Hallo,

With Sheets("Oulook-Kontakte")
  For Each outContactItem In outRealItems
    .Cells(Zeile, 1).Value = outContactItem.Title
    .Cells(Zeile, 2).Value = outContactItem.FirstName
    .Cells(Zeile, 3).Value = outContactItem.LastName
    .Cells(Zeile, 4).Value = outContactItem.JobTitle
    .Cells(Zeile, 5).Value = outContactItem.Department
    .Cells(Zeile, 6).Value = outContactItem.CompanyName
            
    .Cells(Zeile, 8).Value = outContactItem.BusinessAddressStreet
    .Cells(Zeile, 9).Value = outContactItem.BusinessAddressPostalCode
    .Cells(Zeile, 10).Value = outContactItem.BusinessAddressCity
    .Cells(Zeile, 11).Value = outContactItem.BusinessAddressCountry
    .Cells(Zeile, 12).Value = outContactItem.BusinessTelephoneNumber
    .Cells(Zeile, 14).Value = outContactItem.HomeTelephoneNumber
    .Cells(Zeile, 15).Value = outContactItem.Email1Address
            
    .Cells(Zeile, 17).Value = outContactItem.WebPage
     Zeile = Zeile + 1
  Next outContactItem
End With

Gruß
Rudi


  

Betrifft: AW: Menu ist aktiv! von: Space
Geschrieben am: 19.01.2010 14:31:20

Hallo Rudi,

jetzt kommt allerdings an der Stelle: With Sheets("Oulook-Kontakte") der Laufzeitfehler 9: Index ausserhalb des gültigen Bereichs.

Gruß
Space


  

Betrifft: AW: Oulook - Outlook von: dieter(drummer)
Geschrieben am: 19.01.2010 14:37:27

Hi Space,

mir ist nur aufgefallen, dass deine Tabelle nicht "Oulook-Kontakte" heißt, sondern "Outlook Kontakte".
Vielleicht hilfts. Ich will hier Rudi NICHT dazwischen funken, zumal er der Spezialist ist.

Gruß Dieter(Drummer)


  

Betrifft: AW: Menu ist aktiv! von: Rudi Maintaire
Geschrieben am: 19.01.2010 14:47:24

Hallo,
ich hab mich hieran

  'Outlook-Kontakte ins Excel Tabellenblatt "Outlook-Kontakte" übertragen

orientiert.

Gruß
Rudi


  

Betrifft: AW: Menu ist aktiv! von: Space
Geschrieben am: 19.01.2010 15:25:29

Vielen Dank für Eure Hilfe, habe eure Tipps beherzigt und noch 5 mal alles kontrolliert obwohl ich es vorher schon gemacht hatte und jetzt geht´s
Daumen hoch;)!

Habe aber leider schon das nächste Problem, versuche es zu lösen und falls es nicht klappt schreibe ich einen neuen Thread!

dankenden Gruß
Space


  

Betrifft: man kann hier doch noch weiter machen! von: Rudi Maintaire
Geschrieben am: 19.01.2010 14:58:57

du hast die . vergessen!

With Sheets("Oulook-Kontakte")
     For Each outContactItem In outRealItems
       .Cells(Zeile, 1).Value = outContactItem.Title
       .Cells(Zeile, 2).Value = outContactItem.FirstName
Gruß
Rudi


Beiträge aus den Excel-Beispielen zum Thema "Einfügen in neuem Tabellenblatt"