Solved

Convert VBA code to VBS code

Posted on 2003-10-31
9
286 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
  • 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
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

DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

Question has a verified solution.

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

Suggested Solutions

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…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

810 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