Всем, привет!
Подскажите пожалуйста, имеется макрос ниже, он отправляет письма через лотус ноутс с определенным текстом, вставляя туда числовые значения, однако он вставляет значения с форматом 45036945,52, как можно сделать, чтобы он вставлял значения с форматом 45 036 945,52? Плюс можно ли делать рассылка на несколько адеросв, а также в копию ставить несколько адресов?
Заранее спасибо за помощь
Подскажите пожалуйста, имеется макрос ниже, он отправляет письма через лотус ноутс с определенным текстом, вставляя туда числовые значения, однако он вставляет значения с форматом 45036945,52, как можно сделать, чтобы он вставлял значения с форматом 45 036 945,52? Плюс можно ли делать рассылка на несколько адеросв, а также в копию ставить несколько адресов?
Заранее спасибо за помощь
| Код |
|---|
Sub Уведомления()
Dim xx
xx = MsgBox("Расчеты произведены?", vbYesNo, "Провекра")
If xx = 7 Then: Exit Sub
If xx = 6 Then:
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim sFilPath As String
Dim sPwd As String
Dim wrbBal As Workbook
Dim shtData As Worksheet
Dim strName As Range
Dim D As Date
Dim a As Variant
Dim c As Variant
Dim NextCP As Variant
Dim shtMC As Worksheet
Dim rngMCCP As Range
Set nSess = CreateObject("Lotus.NotesSession")
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set wrbBal = ActiveWorkbook
Set shtData = wrbBal.Worksheets("База данных")
Set c = shtData.Range("A2:Q2")
vCCList = "bugaga@mail.ru"
Set strName = shtData.Range("A2")
D = Date
Do Until strName.Value = ""
Set shtMC = wrbBal.Worksheets("MC")
Set rngMCCP = shtMC.Range("A2:G2")
If c.Cells(1, 17) = "К" Then GoTo NextCP
If c.Cells(1, 19) = "R" Then
Do Until rngMCCP.Cells(1, 1).Value = ""
If rngMCCP.Cells(1, 1) = c.Cells(1, 1) Then
If rngMCCP.Cells(1, 2) > 0 Then
vToList = c.Cells(1, 14)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Notification " & strName & " " & D & "")
With nAtt
.AppendText ("Добрый день!")
.AddNewLine
.AddNewLine
.AppendText ("текст" & Abs(rngMCCP.Cells(1, 2)) & " " & rngMCCP.Cells(1, 6) & " text " & rngMCCP.Cells(1, 7) & "")
.AddNewLine
.AddNewLine
.AppendText ("текст: " & rngMCCP.Cells(1, 3) & "")
.AddNewLine
.AppendText ("текст: " & rngMCCP.Cells(1, 4) & "")
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End If
End If
Set rngMCCP = rngMCCP.Offset(1)
Loop
Else:
Do Until rngMCCP.Cells(1, 1).Value = ""
If rngMCCP.Cells(1, 1) = c.Cells(1, 1) Then
If rngMCCP.Cells(1, 2) > 0 Then
vToList = c.Cells(1, 14)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Notification " & strName & " " & D & "")
With nAtt
.AppendText ("Dear All,")
.AddNewLine
.AddNewLine
.AppendText ("TEXT " & strName & " text " & Abs(rngMCCP.Cells(1, 2)) & " " & rngMCCP.Cells(1, 6) & " text" & rngMCCP.Cells(1, 7) & "")
.AddNewLine
.AddNewLine
.AppendText ("TEXT: " & rngMCCP.Cells(1, 3) & "")
.AddNewLine
.AppendText ("TEXT: " & rngMCCP.Cells(1, 4) & "")
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End If
End If
Set rngMCCP = rngMCCP.Offset(1)
Loop
End If
NextCP:
Set strName = strName.Offset(1)
Set c = c.Offset(1)
Loop
End Sub |
Изменено: - 12.10.2016 18:15:45
