[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Phpgroupware-cvs] sync/tools/idgenexport.bas, 1.7
From: |
nomail |
Subject: |
[Phpgroupware-cvs] sync/tools/idgenexport.bas, 1.7 |
Date: |
Tue, 27 Jul 2004 16:47:21 +0200 |
Update of /sync/tools
Modified Files:
Branch:
idgenexport.bas
date: 2004/07/27 14:47:21; author: mleonhardt; state: Exp; lines: +31 -1
Log Message:
- extending Exportmacro: user can now select category of the contacts to export
=====================================================================
Index: sync/tools/idgenexport.bas
diff -u sync/tools/idgenexport.bas:1.6 sync/tools/idgenexport.bas:1.7
--- sync/tools/idgenexport.bas:1.6 Thu Jul 15 09:38:50 2004
+++ sync/tools/idgenexport.bas Tue Jul 27 14:47:21 2004
@@ -126,6 +126,22 @@
GetAddressofFunction = add
End Function
+' This function shows the Outlook Selectcategory Dialog and returns the chosen
category
+Private Function GetSelectedCategory() As String
+ Dim appolApp As Outlook.Application
+ Dim olApptItem As Outlook.AppointmentItem
+
+ 'Create an instance of the application
+ Set appolApp = New Outlook.Application
+ 'Create appointment item
+ Set olApptItem = appolApp.CreateItem(olAppointmentItem)
+
+ 'Display the Show categories dialog
+ olApptItem.ShowCategoriesDialog
+ GetSelectedCategory = olApptItem.Categories
+ olApptItem.Delete
+End Function
+
Sub KontaktIDExport()
Dim objApp As Application
Dim objNS As NameSpace
@@ -140,6 +156,7 @@
Dim ItemWithoutCount As Integer
Dim catdir As String
Dim destdir As String
+ Dim selectedcategory As String
Const defaultdestdir = "c:\"
@@ -164,6 +181,13 @@
MsgBox "Der Zielordner existiert nicht - bitte passen sie das Macro
entsprechend an!"
Else
+ ' show infodialog
+ MsgBox "Bitte wählen Sie im nachfolgenden Dialog eine gewünschte Kategorie
von Kontakten aus. " _
+ + Chr(13) + "Bitte nicht mehrere Kategorien auswählen. " _
+ + Chr(13) + "Wenn Sie keine Kategorie auswählen, werden alle Kontakte
exportiert.", vbOKOnly, "pro|business Kontaktexport by Matthias Leonhardt"
+
+ selectedcategory = GetSelectedCategory
+
objContacts.Items.ResetColumns
Set colItems = objContacts.Items
@@ -190,7 +214,13 @@
' Else
catdir = destdir
' End If
- objItem.SaveAs catdir & "\" & objItem.GovernmentIDNumber & ".vcd",
olVCard
+ If (selectedcategory <> "") Then
+ If (InStr(1, objItem.Categories, selectedcategory, vbTextCompare) >
0) Then
+ objItem.SaveAs catdir & "\" & objItem.GovernmentIDNumber & ".vcd",
olVCard
+ End If
+ Else
+ objItem.SaveAs catdir & "\" & objItem.GovernmentIDNumber & ".vcd",
olVCard
+ End If
End If
Next
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Phpgroupware-cvs] sync/tools/idgenexport.bas, 1.7,
nomail <=