the folder condition is necessary in Outloook VBS

[Simpler45]

help to solve a problem:
the condition if there is no folder ("Globality") it is necessary is created if there is a folder ("Globality") it is removed and again is created

Dim objXls
Dim i, j
Dim myNameSpace
Dim myFolder, myWorkFolder
Dim myOutlook
Dim myItems
Dim myNewFolder
Set objXls = CreateObject("Excel.Application")
objXls.Workbooks.Open "C:\Data.xls"
'укажите путь и имя существующего файла
objXls.Application.Visible = False
Set myOutlook = CreateObject("Outlook.Application")
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(10)
Set myNewFolder = myFolder.Folders.Add("Globality")
j = objXls.ActiveSheet.UsedRange.Rows.Count
For i = 1 To j
Set myItems = myNewFolder.Items.Add("IPM.Contact")
With myItems
.FullName = objXls.ActiveSheet.Range("A" & i).Value & " " & _
objXls.ActiveSheet.Range("B" & i).Value & " " & _
objXls.ActiveSheet.Range("C" & i).Value
.Birthday = objXls.ActiveSheet.Range("D" & i).Value
.Email1Address = objXls.ActiveSheet.Range("E" & i).Value
.Save
End With
Next
objXls.quit
Set objXls = Nothing
Set myOutlook = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myNewFolder = Nothing

 

[Diane Poremsky]

instead of
Set myNewFolder = myFolder.Folders.Add("Globality")

Try this - use on error resume next to keep the macro moving and set the folder. If it errors, create the folder. if you want it deleted and added again, you'll use the same method - attempt to delete it (myNewFolder.Delete) and if it errors, keep moving and create it. (or, check for and delete the contents of the folder after you check to see if it exists.)

On Error Resume Next
Set myNewFolder = myFolder.Folders("Globality")
If myNewFolder Is Nothing Then
Set myNewFolder = myFolder.Folders.Add("Globality")
End If

 

[Simpler45]

thank you very much all turned
help still it is necessary that each time at script start, the folder ("Globality") was cleared of contacts, and contacts from document.xls were added then

 

[Diane Poremsky]

you can either use myNewFolder.delete right after you first set it then instead of checking for it 'if mynewfolder is nothing' , jump right to Adding it.

or loop through the folder and delete the contents - something like this
Set myNewFolder = myFolder.Folders("Globality")
for i = myNewFolder.Items.Count to 1 step -1
myNewFolder.Items(i).Delete
next

 

[Simpler45]

many thanks! everything works!

 

[Simpler45]

help there was one more question.
at creation of the folder ("Birthday") to add in the folder description - date of change of the Birthday.xls file, At the subsequent script performance if date of the description of the folder ("Birthday") in Outlook and date of change of the Birthday.xls file - different, is created the new folder with the description of date of change of the new Birthday.xls file if they identical that anything doesn't occur.

Dim objXls
Dim i, j
Dim myNameSpace
Dim myFolder, myWorkFolder
Dim myOutlook
Dim myItems
Dim myNewFolder
Set objXls = CreateObject("Excel.Application")
objXls.Workbooks.Open "\\SRVDC0802\Install\birthday.xls"
'укажите путь и имя существующего файла
objXls.Application.Visible = False
Set myOutlook = CreateObject("Outlook.Application")
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(10)
On Error Resume Next
Set myNewFolder = myFolder.Folders("Birthday")
If myNewFolder Is Nothing Then
Set myNewFolder = myFolder.Folders.Add("Birthday")
End If
Set myNewFolder = myFolder.Folders("Birthday")
for i = myNewFolder.Items.Count to 1 step -1
myNewFolder.Items(i).Delete
next
j = objXls.ActiveSheet.UsedRange.Rows.Count
For i = 1 To j
Set myItems = myNewFolder.Items.Add("IPM.Contact")
With myItems
.FullName = objXls.ActiveSheet.Range("A" & i).Value & " " & _
objXls.ActiveSheet.Range("B" & i).Value & " " & _
objXls.ActiveSheet.Range("C" & i).Value
.Birthday = objXls.ActiveSheet.Range("D" & i).Value
.Email1Address = objXls.ActiveSheet.Range("E" & i).Value
.Save
End With
Next
objXls.quit
Set objXls = Nothing
Set myOutlook = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myNewFolder = Nothing

 

[Diane Poremsky]

The folder description field should be .Description

Set myNewFolder = myFolder.Folders.Add("Birthday")
myNewFolder.Description = "The Description"

 

[Simpler45]

Create file found property, as now you can link with "The Description"

Function ShowFileInfo(filespec)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filespec)
ShowFileInfo = "Created: " & f.DateCreated
End Function

 

[Diane Poremsky]

Oh, yeah, you need to use the FSO - I missed the part where you wanted to use the date of the XLS sheet as the description.