Тема: Помогите со скриптом с VBA на VBS
вот готовый макрос
1.
Sub DeleteContacts()
Dim myOutlook As Outlook.Application
Dim myInformation As NameSpace
Dim myContacts As Items
Dim i As Long
Dim lngCount As Long
Set myOutlook = CreateObject("Outlook.Application")
Set myInformation = myOutlook.GetNamespace("MAPI")
Set myContacts = myInformation.GetDefaultFolder(olFolderContacts).Items
lngCount = myContacts.Count
For i = lngCount To 1 Step -1
myContacts(i).Delete
Next
End Sub
2
Sub Perenos_Kontaktov_iz_Excel()
Dim objXls As Object
Dim i As Single, j As Single
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder, myWorkFolder As MAPIFolder
Dim myOutlook As Outlook.Application
Dim myItems As ContactItem
Set objXls = CreateObject("Excel.Application")
objXls.Workbooks.Open "C:\Data.xls"
'укажите путь и имя существующего файла
objXls.Application.Visible = False
Set myOutlook = CreateObject("Outlook.Application")
j = objXls.ActiveSheet.UsedRange.Rows.Count
For i = 1 To j
Set myItems = myOutlook.CreateItem(olContactItem)
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 i
Set objXls = Nothing
Set myOutlook = Nothing
End Sub
они написаны на VBA как переделать на VBS?
я вот попробывал переделать 1 код, у меня получилось вот так
Dim objXls
Dim i, j
Dim myNameSpace
Dim myFolder, myWorkFolder
Dim myOutlook
Dim myItems
Set objXls = CreateObject("Excel.Application")
objXls.Workbooks.Open "C:\Data.xls"
'укажите путь и имя существующего файла
objXls.Application.Visible = False
Set myOutlook = CreateObject("Outlook.Application")
j = objXls.ActiveSheet.UsedRange.Rows.Count
For i = 1 To j
Set myItems = myOutlook.CreateItem(olContactItem)
With myItems
.FirstName = objXls.ActiveSheet.Range("A" & i).Value
.LastName = objXls.ActiveSheet.Range("B" & i).Value
.Birthday = objXls.ActiveSheet.Range("D" & i).Value
.Email1Address = objXls.ActiveSheet.Range("E" & i).Value
.Save
End With
Next
Set objXls = Nothing
Set myOutlook = Nothingно выходит ошибка

