Solved

Convert VBA code to VBS code

Posted on 2003-10-31
9
298 Views
Last Modified: 2011-09-20
What needs to be changed in the following code to be able to run it from a VBS file:

Sub FindContact()
   
    Dim olApp As Outlook.Application
    Dim objContact As ContactItem
    Dim objContacts As MAPIFolder
    Dim objNameSpace As NameSpace
    Dim objProperty As UserProperty

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objContacts = objNameSpace.GetDefaultFolder(olFolderContacts)


    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_APQP"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If

    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CE-SALARY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If

    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CIM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CRIB"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DieRoom"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DIVERSITY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DMLEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DTOLEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ERGONOMICS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FLOOR-SUPERVISION"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS_IMPLEMENT_TEAM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS-FOCUS-TEAM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS-Joint-Steering-Committee"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_HR"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ISO_INT-AUDITORS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ISO14001-CFT"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_MPL"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_OPERATING-COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PDC5_COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PE-CLERKS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PE-LEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLANT_ALL"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLANT-SALARY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_Plastics-Value-Stream"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLTENG"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PROD-SUPERINTENDENT"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PRODUCTION"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_REWARDS-COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_SHARP"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_SUPERINTENDENTS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_TOOL-DIE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_UNION-SAFETY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_WHITEROOM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
       
        MsgBox "Finished."
   
End Sub

0
Comment
Question by:Luniz2k1
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
  • 3
9 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9658473
Well, try this:
All variables are variant so you cannot qualify as Outlook.Application, as ContactItem,
as MAPIFolder and so on.
Also, you have to know which values represent each constants since vbs doesn't know about it (in example, olFolderContacts) Check F2 key in IDE to know the real numeric values and use them instead of constants.
You could also create your own constants but have to be defined before use anyway.
0
 
LVL 5

Author Comment

by:Luniz2k1
ID: 9658634
Let me add that I am a VB beginner.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9658993
Ok. I don't use Outlook so i cannot test it, besides, i never automate it so be my guest:


Sub FindContact()
   
    Dim olApp
    Dim objContact
    Dim objContacts
    Dim objNameSpace
    Dim objProperty

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objContacts = objNameSpace.GetDefaultFolder(10)


    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_APQP"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If

    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CE-SALARY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If

    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CIM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_CRIB"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DieRoom"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DIVERSITY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DMLEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_DTOLEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ERGONOMICS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FLOOR-SUPERVISION"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS_IMPLEMENT_TEAM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS-FOCUS-TEAM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_FPS-Joint-Steering-Committee"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_HR"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ISO_INT-AUDITORS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_ISO14001-CFT"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_MPL"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_OPERATING-COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PDC5_COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PE-CLERKS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PE-LEADERS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLANT_ALL"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLANT-SALARY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_Plastics-Value-Stream"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PLTENG"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PROD-SUPERINTENDENT"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_PRODUCTION"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_REWARDS-COMMITTEE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_SHARP"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_SUPERINTENDENTS"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_TOOL-DIE"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_UNION-SAFETY"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
   
    Set objContact = objContacts.Items.Find("[FileAs] = ""MAU_WHITEROOM"" ")
    If Not TypeName(objContact) = "Nothing" Then
        objContact.Delete
    End If
       
        MsgBox "Finished."
   
End Sub


That's should be enought.
I have doubts about "nothing" since it is a string but well, if code works in other context, that's fine.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 29

Accepted Solution

by:
leonstryker earned 500 total points
ID: 9659022
As Richie_Simonetti pointed out you will need to do the following:

Delete this:
    Dim olApp As Outlook.Application
    Dim objContact As ContactItem
    Dim objContacts As MAPIFolder
    Dim objNameSpace As NameSpace
    Dim objProperty As UserProperty

The numeric value for olFolderContacts = 10

So change this:

Set objContacts = objNameSpace.GetDefaultFolder(olFolderContacts)

to this

Set objContacts = objNameSpace.GetDefaultFolder(10)
0
 
LVL 29

Expert Comment

by:leonstryker
ID: 9659198
You really should give Richie_Simonetti  he came up with the answer faster
0
 
LVL 5

Author Comment

by:Luniz2k1
ID: 9659240
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9659249
Luniz2k1, that's nice!
0
 
LVL 29

Expert Comment

by:leonstryker
ID: 9659257
Luniz2k1,

That is very nice of you, I am impressed

Leon
0
 
LVL 5

Author Comment

by:Luniz2k1
ID: 9659298
Couldnt have done it without help.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Computer crashes, following error message in event manager 5 278
VBA Shell can't Find Word document 11 127
Dinamic report to Crosstab query 9 49
Set WorkSheet  not Working 9 51
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question