Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Convert VBA code to VBS code

Posted on 2003-10-31
9
Medium Priority
?
323 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 2000 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 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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

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.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
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…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses

688 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