[more]
Option Explicit
Dim MaxRow As Long
Dim totCustomer As Long
Dim check1 As Integer
Dim check2 As Integer
Dim check3 As Integer
Dim check4 As Integer
Dim flagExitCheck As Boolean
Dim i As Integer
Function Sheet(NameSVColumn As String) As boolen
Sub SendEMail_via_CDO()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
'add NameSVColumn;EmailSVIDColumn
Dim NameSVColumn As String
Dim EmailSVIDColumn As String
Dim NameColumn As String
Dim EmailIDColumn As String
Dim PhoneColumn As String
Dim AmountColumn As String
Dim DataStartRow As Integer
Dim ReportMonth As String
Dim ReportYear As String
Dim SRow As Long
Dim Flds As Variant
totCustomer = 0
On Error GoTo err_SendEMail_via_CDO
'Check whether the user is connected to the Network, else show an error msg
If IsConnected = True Then
Else
MsgBox "You can't use this subroutine because you are not connected to Network.", vbCritical
End If
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtpam.shell.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-ea.services.shell.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
NameSVColumn = cbonamesvcol.Text
EmailSVIDColumn = cboemailsvidcol.Text
NameColumn = cbonamecol.Text
EmailIDColumn = cboemailidcol.Text
PhoneColumn = cbophonecol.Text
AmountColumn = cboamtcol.Text
DataStartRow = cboDatastartRow.Text
ReportMonth = cbomonth.Text
ReportYear = cboyear.Text
Application.Cursor = xlWait
End Function
For SRow = DataStartRow To MaxRow
If Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow) = "" Then Exit Sub
strbody = "mobile phone / ìîáèëüíûé òåëåôîí" & Chr$(10) & "----------------------------------------------------" & Chr$(10)
strbody = strbody & " " & Range(PhoneColumn & SRow & ":" & PhoneColumn & SRow) & " (" & Range(NameColumn & SRow & ":" & NameColumn & SRow) & ")" & Chr$(10)
strbody = strbody & " " & Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow) & Trim(txtTosuffix.Text) & Chr$(10) & Chr$(10)
strbody = strbody & "monthly expenses / çàòðàòû çà ìåñÿö" & Chr$(10) & "--------------------------------------------------------" & Chr$(10)
strbody = strbody & " " & ReportMonth & "." & ReportYear & Chr$(10)
strbody = strbody & " $" & Range(AmountColumn & SRow & ":" & AmountColumn & SRow) & " USD" & Chr$(10)
strbody = strbody & Chr$(10) & "(ðóññêèé òåêñò ñëåäóåò çà àíãëèéñêèì)" & Chr$(10)
strbody = strbody & Chr$(10) & txtEmailBody_Eng.Text & Chr$(10) & Chr$(10) & "---------------------------------------------------------------------------------------------------------------------------------------------------------" & Chr$(10) & Chr$(10) & txtEmailBody_Rus.Text & Chr$(10)
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.From = txtFromMailID.Text
.To = Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow) & Trim(txtTosuffix.Text)
.CC = ""
.BCC = ""
.Subject = "(" & Range(PhoneColumn & SRow & ":" & PhoneColumn & SRow) & ") " & Trim(txtSubject.Text)
.TextBody = strbody
.Send
End With
totCustomer = totCustomer + 1
Set iMsg = Nothing
DoEvents
Next
Set iConf = Nothing
Application.Cursor = xlDefault
Exit Sub
err_SendEMail_via_CDO:
MsgBox "Error while sending e-mails via CDO.", vbCritical
Application.Cursor = xlDefault
End Sub
Sub SendEMail_via_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
'add NameSVColumn;EmailSVIDColumn
Dim NameSVColumn As String
Dim EmailSVIDColumn As String
Dim NameColumn As String
Dim EmailIDColumn As String
Dim PhoneColumn As String
Dim AmountColumn As String
Dim DataStartRow As Integer
Dim ReportMonth As String
Dim ReportYear As String
Dim SRow As Long
Dim Flds As Variant
totCustomer = 0
On Error GoTo err_SendEMail_via_Outlook
Set OutApp = CreateObject("Outlook.Application")
'OutApp.Session.Logon
NameSVColumn = cbonamesvcol.Text
EmailSVIDColumn = cboemailsvidcol.Text
NameColumn = cbonamecol.Text
EmailIDColumn = cboemailidcol.Text
PhoneColumn = cbophonecol.Text
AmountColumn = cboamtcol.Text
DataStartRow = cboDatastartRow.Text
ReportMonth = cbomonth.Text
ReportYear = cboyear.Text
Application.Cursor = xlWait
For SRow = DataStartRow To MaxRow
If Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow).Value = "" Then Exit Sub
Set OutMail = OutApp.CreateItem(0)
strbody = "mobile phone / ìîáèëüíûé òåëåôîí" & Chr$(10) & "----------------------------------------------------" & Chr$(10)
strbody = strbody & " " & Range(PhoneColumn & SRow & ":" & PhoneColumn & SRow) & " (" & Range(NameColumn & SRow & ":" & NameColumn & SRow) & ")" & Chr$(10)
strbody = strbody & " " & Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow) & Trim(txtTosuffix.Text) & Chr$(10) & Chr$(10)
strbody = strbody & "monthly expenses / çàòðàòû çà ìåñÿö" & Chr$(10) & "--------------------------------------------------------" & Chr$(10)
strbody = strbody & " " & ReportMonth & "." & ReportYear & Chr$(10)
strbody = strbody & " $" & Range(AmountColumn & SRow & ":" & AmountColumn & SRow) & " USD" & Chr$(10)
strbody = strbody & Chr$(10) & "(ðóññêèé òåêñò ñëåäóåò çà àíãëèéñêèì)" & Chr$(10)
strbody = strbody & Chr$(10) & txtEmailBody_Eng.Text & Chr$(10) & Chr$(10) & "---------------------------------------------------------------------------------------------------------------------------------------------------------" & Chr$(10) & Chr$(10) & txtEmailBody_Rus.Text & Chr$(10)
'On Error Resume Next
With OutMail
.To = Range(EmailIDColumn & SRow & ":" & EmailIDColumn & SRow) & Trim(txtTosuffix.Text)
.CC = ""
.BCC = ""
.Subject = "(" & Range(PhoneColumn & SRow & ":" & PhoneColumn & SRow) & ") " & Trim(txtSubject.Text)
.body = strbody
.Save
' "Save" - saves the e-mails in to Draft folder of the Mailbox
' The reason why ".Send" was not used was due to security warning msg that pops-up due to W2K SP2 security patch
End With
'On Error GoTo 0
totCustomer = totCustomer + 1
Set OutMail = Nothing
DoEvents
Next
Set OutApp = Nothing
Application.Cursor = xlDefault
Exit Sub
err_SendEMail_via_Outlook:
MsgBox "Error while sending e-mails via MS Outlook.", vbCritical
Application.Cursor = xlDefault
End Sub
Private Sub cboamtcol_Change()
End Sub
Private Sub cboDatastartRow_Change()
End Sub
Private Sub cboemailidcol_Change()
End Sub
Private Sub cboemailsvidcol_Change()
End Sub
Private Sub cbomonth_Change()
End Sub
Private Sub cbonamecol_Change()
End Sub
Private Sub cbonamesvcol_Change()
End Sub
Private Sub cbophonecol_Change()
End Sub
Private Sub cboyear_Change()
End Sub
Private Sub CmdClose_Click()
' Code For Exit for the form
If MsgBox("Are you sure, want to close the " & MsgTitle & "?", vbYesNo + vbQuestion, MsgTitle) = vbYes Then
flagExitCheck = True
Unload Me
Else
flagExitCheck = False
End If
End Sub
Private Sub cmdhelp_Click()
' On click of Help button, show the Help window
UFrmHelp.Show vbModal
End Sub
Private Sub cmdhelp1_Click()
End Sub
Private Sub CmdSend_Click()
' Input validation
If Trim(txtEmailBody_Eng.Text) = "" Then
MsgBox "Enter the English e-mail body text.", vbExclamation, MsgTitle
Exit Sub
End If
If Trim(txtEmailBody_Rus.Text) = "" Then
MsgBox "Enter the Russian e-mail body text.", vbExclamation, MsgTitle
Exit Sub
End If
If Trim(txtSubject.Text) = "" Then
MsgBox "Enter the e-mail subject line text.", vbExclamation, MsgTitle
Exit Sub
End If
If Trim(txtFromMailID.Text) = "" Then
MsgBox "Enter the From e-mail ID.", vbExclamation, MsgTitle
Exit Sub
End If
If Trim(txtTosuffix.Text) = "" Then
MsgBox "Enter the correct To e-mail Suffix.", vbExclamation, MsgTitle
Exit Sub
Else
check1 = InStr(1, txtTosuffix.Text, "@")
check2 = InStr(1, txtTosuffix.Text, ".")
check3 = InStr(1, txtTosuffix.Text, " ")
check4 = InStr(1, txtTosuffix.Text, ",")
If check1 = 0 Or check2 = 0 Or check3 <> 0 Or check4 <> 0 Then
MsgBox "Enter the correct To E-mail Suffix.", vbExclamation, MsgTitle
Exit Sub
End If
End If
If MsgBox("Are you sure, you want to send e-mails?", vbYesNo + vbQuestion, MsgTitle) = vbYes Then
lblstatusofsending.Caption = "Sending e-mails... please wait."
CmdSend.Enabled = False
CmdClose.Enabled = False
Application.ScreenUpdating = False
If optCDO.Value = True Then
Call SendEMail_via_CDO
Else
Call SendEMail_via_Outlook
End If
lblstatusofsending.Caption = ""
Application.ScreenUpdating = True
' This code for displaying the result
If totCustomer = 0 Then
MsgBox "No data found in the worksheet for the above selections. Please check the worksheet data and make correct selections (column and row number) above.", vbInformation, MsgTitle
Else
MsgBox "E-mail has been sent to " & totCustomer & " mobile user(s).", vbInformation, MsgTitle
End If
End If
Application.Cursor = xlDefault
CmdSend.Enabled = True
CmdClose.Enabled = True
End Sub
Private Sub txtEmailBody_Change()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub cmomonth_Change()
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub frmframe_Click()
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Image4_Click()
End Sub
Private Sub Image6_Click()
End Sub
Private Sub Image8_Click()
End Sub
Private Sub Image9_Click()
End Sub
Private Sub Label11_Click()
End Sub
Private Sub Label12_Click()
End Sub
Private Sub Label15_Click()
End Sub
Private Sub Label16_Click()
End Sub
Private Sub Label17_Click()
End Sub
Private Sub lblAmtCol_Click()
End Sub
Private Sub optCDO_Click()
End Sub
Private Sub txtEmailBody_Eng_Change()
End Sub
Private Sub txtEmailBody_Rus_Change()
End Sub
Private Sub txtSubject_Change()
End Sub
Private Sub txtTosuffix_Change()
End Sub
Private Sub UserForm_Initialize()
Dim PrevMonth As Integer
Dim PrevYear As Integer
PrevMonth = Month(Date) - 1
If PrevMonth <= 0 Then
PrevMonth = 12
PrevYear = Year(Date) - 1
Else
PrevYear = Year(Date)
End If
cbonamesvcol.AddItem "A"
cbonamesvcol.AddItem "B"
cbonamesvcol.AddItem "C"
cbonamesvcol.AddItem "D"
cbonamesvcol.AddItem "E"
cbonamesvcol.AddItem "F"
cbonamesvcol.AddItem "G"
cbonamesvcol.AddItem "H"
cbonamesvcol.AddItem "I"
cbonamesvcol.AddItem "J"
cbonamesvcol.AddItem "K"
cbonamesvcol.AddItem "L"
cbonamesvcol.AddItem "M"
cbonamesvcol.AddItem "N"
cbonamesvcol.AddItem "O"
cbonamesvcol.AddItem "P"
cbonamesvcol.AddItem "Q"
cbonamesvcol.AddItem "R"
cbonamesvcol.AddItem "S"
cbonamesvcol.AddItem "T"
cbonamesvcol.AddItem "U"
cbonamesvcol.AddItem "V"
cbonamesvcol.AddItem "W"
cbonamesvcol.AddItem "X"
cbonamesvcol.AddItem "Y"
cbonamesvcol.AddItem "Z"
cbonamesvcol.AddItem "AA"
cbonamesvcol.AddItem "AB"
cbonamesvcol.AddItem "AC"
cbonamesvcol.AddItem "AD"
cbonamesvcol.AddItem "AE"
cbonamesvcol.AddItem "AF"
cbonamesvcol.AddItem "AG"
cbonamesvcol.AddItem "AH"
cbonamesvcol.AddItem "AI"
cbonamesvcol.AddItem "AJ"
cbonamesvcol.AddItem "AK"
cbonamesvcol.AddItem "AL"
cbonamesvcol.AddItem "AM"
cbonamesvcol.AddItem "AN"
cbonamesvcol.AddItem "AO"
cbonamesvcol.AddItem "AP"
cbonamesvcol.AddItem "AQ"
cbonamesvcol.AddItem "AR"
cbonamesvcol.AddItem "AS"
cbonamesvcol.AddItem "AT"
cbonamesvcol.AddItem "AU"
cbonamesvcol.AddItem "AV"
cbonamesvcol.AddItem "AW"
cbonamesvcol.AddItem "AX"
cbonamesvcol.AddItem "AY"
cbonamesvcol.AddItem "AZ"
' This line for "A Column should be selected by degault"
cbonamesvcol.ListIndex = 0
cboemailsvidcol.AddItem "A"
cboemailsvidcol.AddItem "B"
cboemailsvidcol.AddItem "C"
cboemailsvidcol.AddItem "D"
cboemailsvidcol.AddItem "E"
cboemailsvidcol.AddItem "F"
cboemailsvidcol.AddItem "G"
cboemailsvidcol.AddItem "H"
cboemailsvidcol.AddItem "I"
cboemailsvidcol.AddItem "J"
cboemailsvidcol.AddItem "K"
cboemailsvidcol.AddItem "L"
cboemailsvidcol.AddItem "M"
cboemailsvidcol.AddItem "N"
cboemailsvidcol.AddItem "O"
cboemailsvidcol.AddItem "P"
cboemailsvidcol.AddItem "Q"
cboemailsvidcol.AddItem "R"
cboemailsvidcol.AddItem "S"
cboemailsvidcol.AddItem "T"
cboemailsvidcol.AddItem "U"
cboemailsvidcol.AddItem "V"
cboemailsvidcol.AddItem "W"
cboemailsvidcol.AddItem "X"
cboemailsvidcol.AddItem "Y"
cboemailsvidcol.AddItem "Z"
cboemailsvidcol.AddItem "AA"
cboemailsvidcol.AddItem "AB"
cboemailsvidcol.AddItem "AC"
cboemailsvidcol.AddItem "AD"
cboemailsvidcol.AddItem "AE"
cboemailsvidcol.AddItem "AF"
cboemailsvidcol.AddItem "AG"
cboemailsvidcol.AddItem "AH"
cboemailsvidcol.AddItem "AI"
cboemailsvidcol.AddItem "AJ"
cboemailsvidcol.AddItem "AK"
cboemailsvidcol.AddItem "AL"
cboemailsvidcol.AddItem "AM"
cboemailsvidcol.AddItem "AN"
cboemailsvidcol.AddItem "AO"
cboemailsvidcol.AddItem "AP"
cboemailsvidcol.AddItem "AQ"
cboemailsvidcol.AddItem "AR"
cboemailsvidcol.AddItem "AS"
cboemailsvidcol.AddItem "AT"
cboemailsvidcol.AddItem "AU"
cboemailsvidcol.AddItem "AV"
cboemailsvidcol.AddItem "AW"
cboemailsvidcol.AddItem "AX"
cboemailsvidcol.AddItem "AY"
cboemailsvidcol.AddItem "AZ"
' This line for "B Column should be selected by default"
cboemailsvidcol.ListIndex = 1
cbonamecol.AddItem "A"
cbonamecol.AddItem "B"
cbonamecol.AddItem "C"
cbonamecol.AddItem "D"
cbonamecol.AddItem "E"
cbonamecol.AddItem "F"
cbonamecol.AddItem "G"
cbonamecol.AddItem "H"
cbonamecol.AddItem "I"
cbonamecol.AddItem "J"
cbonamecol.AddItem "K"
cbonamecol.AddItem "L"
cbonamecol.AddItem "M"
cbonamecol.AddItem "N"
cbonamecol.AddItem "O"
cbonamecol.AddItem "P"
cbonamecol.AddItem "Q"
cbonamecol.AddItem "R"
cbonamecol.AddItem "S"
cbonamecol.AddItem "T"
cbonamecol.AddItem "U"
cbonamecol.AddItem "V"
cbonamecol.AddItem "W"
cbonamecol.AddItem "X"
cbonamecol.AddItem "Y"
cbonamecol.AddItem "Z"
cbonamecol.AddItem "AA"
cbonamecol.AddItem "AB"
cbonamecol.AddItem "AC"
cbonamecol.AddItem "AD"
cbonamecol.AddItem "AE"
cbonamecol.AddItem "AF"
cbonamecol.AddItem "AG"
cbonamecol.AddItem "AH"
cbonamecol.AddItem "AI"
cbonamecol.AddItem "AJ"
cbonamecol.AddItem "AK"
cbonamecol.AddItem "AL"
cbonamecol.AddItem "AM"
cbonamecol.AddItem "AN"
cbonamecol.AddItem "AO"
cbonamecol.AddItem "AP"
cbonamecol.AddItem "AQ"
cbonamecol.AddItem "AR"
cbonamecol.AddItem "AS"
cbonamecol.AddItem "AT"
cbonamecol.AddItem "AU"
cbonamecol.AddItem "AV"
cbonamecol.AddItem "AW"
cbonamecol.AddItem "AX"
cbonamecol.AddItem "AY"
cbonamecol.AddItem "AZ"
' This line for "A Column should be selected by degault"
cbonamecol.ListIndex = 0
cboemailidcol.AddItem "A"
cboemailidcol.AddItem "B"
cboemailidcol.AddItem "C"
cboemailidcol.AddItem "D"
cboemailidcol.AddItem "E"
cboemailidcol.AddItem "F"
cboemailidcol.AddItem "G"
cboemailidcol.AddItem "H"
cboemailidcol.AddItem "I"
cboemailidcol.AddItem "J"
cboemailidcol.AddItem "K"
cboemailidcol.AddItem "L"
cboemailidcol.AddItem "M"
cboemailidcol.AddItem "N"
cboemailidcol.AddItem "O"
cboemailidcol.AddItem "P"
cboemailidcol.AddItem "Q"
cboemailidcol.AddItem "R"
cboemailidcol.AddItem "S"
cboemailidcol.AddItem "T"
cboemailidcol.AddItem "U"
cboemailidcol.AddItem "V"
cboemailidcol.AddItem "W"
cboemailidcol.AddItem "X"
cboemailidcol.AddItem "Y"
cboemailidcol.AddItem "Z"
cboemailidcol.AddItem "AA"
cboemailidcol.AddItem "AB"
cboemailidcol.AddItem "AC"
cboemailidcol.AddItem "AD"
cboemailidcol.AddItem "AE"
cboemailidcol.AddItem "AF"
cboemailidcol.AddItem "AG"
cboemailidcol.AddItem "AH"
cboemailidcol.AddItem "AI"
cboemailidcol.AddItem "AJ"
cboemailidcol.AddItem "AK"
cboemailidcol.AddItem "AL"
cboemailidcol.AddItem "AM"
cboemailidcol.AddItem "AN"
cboemailidcol.AddItem "AO"
cboemailidcol.AddItem "AP"
cboemailidcol.AddItem "AQ"
cboemailidcol.AddItem "AR"
cboemailidcol.AddItem "AS"
cboemailidcol.AddItem "AT"
cboemailidcol.AddItem "AU"
cboemailidcol.AddItem "AV"
cboemailidcol.AddItem "AW"
cboemailidcol.AddItem "AX"
cboemailidcol.AddItem "AY"
cboemailidcol.AddItem "AZ"
' This line for "B Column should be selected by default"
cboemailidcol.ListIndex = 1
cbophonecol.AddItem "A"
cbophonecol.AddItem "B"
cbophonecol.AddItem "C"
cbophonecol.AddItem "D"
cbophonecol.AddItem "E"
cbophonecol.AddItem "F"
cbophonecol.AddItem "G"
cbophonecol.AddItem "H"
cbophonecol.AddItem "I"
cbophonecol.AddItem "J"
cbophonecol.AddItem "K"
cbophonecol.AddItem "L"
cbophonecol.AddItem "M"
cbophonecol.AddItem "N"
cbophonecol.AddItem "O"
cbophonecol.AddItem "P"
cbophonecol.AddItem "Q"
cbophonecol.AddItem "R"
cbophonecol.AddItem "S"
cbophonecol.AddItem "T"
cbophonecol.AddItem "U"
cbophonecol.AddItem "V"
cbophonecol.AddItem "W"
cbophonecol.AddItem "X"
cbophonecol.AddItem "Y"
cbophonecol.AddItem "Z"
cbophonecol.AddItem "AA"
cbophonecol.AddItem "AB"
cbophonecol.AddItem "AC"
cbophonecol.AddItem "AD"
cbophonecol.AddItem "AE"
cbophonecol.AddItem "AF"
cbophonecol.AddItem "AG"
cbophonecol.AddItem "AH"
cbophonecol.AddItem "AI"
cbophonecol.AddItem "AJ"
cbophonecol.AddItem "AK"
cbophonecol.AddItem "AL"
cbophonecol.AddItem "AM"
cbophonecol.AddItem "AN"
cbophonecol.AddItem "AO"
cbophonecol.AddItem "AP"
cbophonecol.AddItem "AQ"
cbophonecol.AddItem "AR"
cbophonecol.AddItem "AS"
cbophonecol.AddItem "AT"
cbophonecol.AddItem "AU"
cbophonecol.AddItem "AV"
cbophonecol.AddItem "AW"
cbophonecol.AddItem "AX"
cbophonecol.AddItem "AY"
cbophonecol.AddItem "AZ"
' This line for "C Column should be selected by degault"
cbophonecol.ListIndex = 2
cboamtcol.AddItem "A"
cboamtcol.AddItem "B"
cboamtcol.AddItem "C"
cboamtcol.AddItem "D"
cboamtcol.AddItem "E"
cboamtcol.AddItem "F"
cboamtcol.AddItem "G"
cboamtcol.AddItem "H"
cboamtcol.AddItem "I"
cboamtcol.AddItem "J"
cboamtcol.AddItem "K"
cboamtcol.AddItem "L"
cboamtcol.AddItem "M"
cboamtcol.AddItem "N"
cboamtcol.AddItem "O"
cboamtcol.AddItem "P"
cboamtcol.AddItem "Q"
cboamtcol.AddItem "R"
cboamtcol.AddItem "S"
cboamtcol.AddItem "T"
cboamtcol.AddItem "U"
cboamtcol.AddItem "V"
cboamtcol.AddItem "W"
cboamtcol.AddItem "X"
cboamtcol.AddItem "Y"
cboamtcol.AddItem "Z"
cboamtcol.AddItem "AA"
cboamtcol.AddItem "AB"
cboamtcol.AddItem "AC"
cboamtcol.AddItem "AD"
cboamtcol.AddItem "AE"
cboamtcol.AddItem "AF"
cboamtcol.AddItem "AG"
cboamtcol.AddItem "AH"
cboamtcol.AddItem "AI"
cboamtcol.AddItem "AJ"
cboamtcol.AddItem "AK"
cboamtcol.AddItem "AL"
cboamtcol.AddItem "AM"
cboamtcol.AddItem "AN"
cboamtcol.AddItem "AO"
cboamtcol.AddItem "AP"
cboamtcol.AddItem "AQ"
cboamtcol.AddItem "AR"
cboamtcol.AddItem "AS"
cboamtcol.AddItem "AT"
cboamtcol.AddItem "AU"
cboamtcol.AddItem "AV"
cboamtcol.AddItem "AW"
cboamtcol.AddItem "AX"
cboamtcol.AddItem "AY"
cboamtcol.AddItem "AZ"
' This line for "D Column should be selected by degault"
cboamtcol.ListIndex = 3
cbomonth.AddItem "01"
cbomonth.AddItem "02"
cbomonth.AddItem "03"
cbomonth.AddItem "04"
cbomonth.AddItem "05"
cbomonth.AddItem "06"
cbomonth.AddItem "07"
cbomonth.AddItem "08"
cbomonth.AddItem "09"
cbomonth.AddItem "10"
cbomonth.AddItem "11"
cbomonth.AddItem "12"
cbomonth.AddItem Month(Date)
cbomonth.AddItem Date
' This line for "Previous month should be selected by default"
cbomonth.ListIndex = PrevMonth - 1
cboyear.AddItem "2007"
cboyear.AddItem "2008"
cboyear.AddItem "2009"
cboyear.AddItem "2010"
cboyear.AddItem "2011"
cboyear.AddItem "2012"
cboyear.AddItem "2013"
cboyear.AddItem "2014"
cboyear.AddItem "2015"
cboyear.AddItem "2016"
cboyear.AddItem "2017"
cboyear.AddItem "2018"
cboyear.AddItem "2019"
cboyear.AddItem "2020"
' This line for "Year of previous month should be selected by default"
cboyear.ListIndex = PrevYear - 2007
frmframe.Visible = True
For i = 1 To 20
cboDatastartRow.AddItem i
Next
' This line for "Start Row 3 should be selected by default"
cboDatastartRow.ListIndex = 1
MaxRow = 65000
totCustomer = 0
' declarations
'txtFromMailID.Value = "Maxim.Shadura@shell.com"
txtFromMailID.Value = "EP-MOW-IT-SUPPORT@shell.com"
txtTosuffix.Value = "@shell.com"
txtSubject.Value = "Monthly mobile phone expenses / Ìåñÿ÷íûå çàòðàòû íà ìîáèëüíûé òåëåôîí"
txtEmailBody_Eng.Value = "Dear Customer," & Chr$(10) & "Please mind the expenses associated to your corporate mobile phone for the last month." & Chr$(10) & "Also please be reminded with the following regulations of the Corporate Mobile Phones Use Policy:" & Chr$(10) & " - company-provided mobile phones are obviously intended primarily for business use;" & Chr$(10) & " - the limit of reasonable personal use is herein set at $20 USD per month;" & Chr$(10) & " - the Company reserves right to request any employee whose expense on mobile communication is suspiciously high, to justify spend as business vs. personal use;" & Chr$(10) & " - in such case should overspend on personal calls be identified, amount in excess of $20 USD can be deducted from the individual’s salary and / or can lead to withdrawal of the Company’s mobile phone from the employee." & Chr$(10) & "The report on mobile expenses is being regularly provided to the Company's management." & Chr$(10) & Chr$(10)
txtEmailBody_Eng.Value = txtEmailBody_Eng.Value & "If you wish to see a detailed breakdown of calls made during the month - please make a request at EP Request Management Site at
http://ep-requestsite.shell.com (use the category Voice Services -> Mobile Phone -> Detailed Mobile Phone Expenses Report)." & Chr$(10) & Chr$(10) & "The full version of the corporate Mobile Phones Use Policy can be found at
http://swweu-epp-project.shell.com/glasepp/livelink.exe/fetch/-23118/23207/24964/24970/2528960/Demand_management_-_mobile_phones_E.pdf?nodeid=2528850&vernum=0." txtEmailBody_Rus.Value = "Óâàæàåìûé ïîëüçîâàòåëü," & Chr$(10) & "Ïîæàëóéñòà îáðàòèòå âíèìàíèå íà ðàçìåð ñ÷åòà ïî íîìåðó Âàøåãî êîðïîðàòèâíîãî ìîáèëüíîãî òåëåôîíà çà ïîñëåäíèé ìåñÿö." & Chr$(10) & "Ïîçâîëüòå òàêæå íàïîìíèòü Âàì ñëåäóþùèå ïîëîæåíèÿ Ïîëèòèêè êîìïàíèè ïî èñïîëüçîâàíèþ ìîáèëüíûõ òåëåôîíîâ:" & Chr$(10) & " - ìîáèëüíûå òåëåôîíû, ïðåäîñòàâëåííûå êîìïàíèåé, ïðåäíàçíà÷åíû ïðåèìóùåñòâåííî äëÿ èñïîüçîâàíèÿ â ðàáî÷èõ öåëÿõ;" & Chr$(10) & " - ïðèåìëèìûé ðàçìåð çàòðàò íà èñïîëüçîâàíèå êîðïîðàòèâíîãî òåëåôîíà â ëè÷íûõ öåëÿõ ñîñòàâëÿåò $20 USD â ìåñÿö;" & Chr$(10) & " - Êîìïàíèÿ îñòàâëÿåò çà ñîáîé ïðàâî çàïðîñèòü ó ñîòðóäíèêà, ÷üè ðàñõîäû íà ìîáèëüíóþ ñâÿçü ïîäîçðèòåëüíî âûñîêè, ðàñøèôðîâêó åãî çâîíêîâ ñ ðàçáèâêîé íà ëè÷íûå è ðàáî÷èå;" & Chr$(10) & " - â ñëó÷àå âûÿâëåíèÿ ïåðåðàñõîäà íà ëè÷íûå çâîíêè, ñóììà ñâûøå $20 USD ìîæåò áûòü óäåðæàíà èç çàðàáîòíîé ïëàòû ñîòðóäíèêà è / èëè ïðèâåñòè ê èçúÿòèþ êîðïîðàòèâíîãî ìîáèëüíîãî òåëåôîíà." & Chr$(10)
txtEmailBody_Rus.Value = txtEmailBody_Rus.Value & "Îò÷åò ïî ðàñõîäàì íà ìîáèëüíóþ ñâÿçü ðåãóëÿðíî ïðåäîñòàâëÿåòñÿ ðóêîâîäñòâó Êîìïàíèè." & Chr$(10) & Chr$(10) & "Åñëè Âû õîòèòå ïîëó÷èòü ðàñøèôðîâêó ñâîèõ òåëåôîííûõ çâîíêîâ çà ìåñÿö, òî îôîðìèòå çàïðîñ íà EP Request Management ñàéòå
http://ep-requestsite.shell.com (èñïîëüçóéòå êàòåãîðèþ Voice Services -> Mobile Phone -> Detailed Mobile Phone Expenses Report)." & Chr$(10) & Chr$(10) & "Ïîëíàÿ âåðñèÿ Ïîëèòèêè êîìïàíèè ïî èñïîëüçîâàíèþ ìîáèëüíûõ òåëåôîíîâ äîñòóïíà ï ññûëêå
http://swweu-epp-project.shell.com/glasepp/livelink.exe/fetch/-23118/23207/24964/24970/2528960/Demand_management_-_mobile_phones_E.pdf?nodeid=2528850&vernum=0." ' Main form caption
UFrmMain.Caption = MsgTitle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If flagExitCheck = False Then
If MsgBox("Are you sure, want to close the " & MsgTitle & "?", vbYesNo + vbQuestion, MsgTitle) = vbYes Then
Unload Me
Else
Cancel = 1
End If
End If
End Sub
[/more]
вот в общем то главная суть
И поясни - предыдущая функция тебя устроила? Или же "вообще не в ту степь" и надо анализировать задачу сначала?
Однако, шайтан, идеи кончились 