Dear All,

Please find below the macro , which is working in Excel 2003 but not working in Excel 2010.

Please help me to solve this issue.

Dim Foldername As String, to_addressee As String, Cc_addressee As String
Dim intPercent As Integer, intBeforePercent As Integer
Dim Action As Variant, Mail_Start As Variant, Mail_End As Variant, Record As Variant, i As Variant
Dim sngBarMaxWidth As Single
Sub Make_email()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

WIN_PRG = ActiveWindow.Caption

Mail_Start = Sheets("menu").Range("e_mail_start").Value

Mail_End = Sheets("menu").Range("e_mail_end").Value

MAIL_title = Sheets("menu").Range("e_mail_title").Value
MAIL1_endrecord = Sheets("menu").Range("mail_1_endrecord").Value
MAIL2_startrecord = Sheets("menu").Range("mail_2_startrecord").Value
MAIL2_endrecord = Sheets("menu").Range("mail_2_endrecord").Value

EX1 = "　　" + Sheets("menu").Range("explanation1").Value
EX2 = "　　" + Sheets("menu").Range("explanation2").Value
EX3 = "　　" + Sheets("menu").Range("explanation3").Value

Foldername = Sheets("menu").Range("foldername").Value

Filename = "　　" + Sheets("menu").Range("filename").Value
File = Sheets("menu").Range("filename").Value

'メール本文の作成*************************************************************
Sheets("emailtext").Select
For Record = 1 To MAIL1_endrecord
celltext = "$B$" & Record
MAILtext1 = MAILtext1 + Sheets("emailtext").Range(celltext).Value + vbLf
Next Record
MAILtext1 = MAILtext1

For Record = MAIL2_startrecord To MAIL2_endrecord
celltext = "$B$" & Record
MAILtext2 = MAILtext2 + Sheets("emailtext").Range(celltext).Value + vbLf
Next Record
MAILtext2 = MAILtext2 + vbLf

'メールの作成*************************************************************
For Action = Mail_Start To Mail_End

'サプライヤ名
cellCODE = "$B$" & (Action + 1)
cellNAME = "$C$" & (Action + 1)
cellUNIT = "$D$" & (Action + 1)
S_CODE = Sheets("PPM_suppliers").Range(cellCODE).Value
S_NAME = Sheets("PPM_suppliers").Range(cellNAME).Value
S_UNIT = Sheets("PPM_suppliers").Range(cellUNIT).Value

'添付ファイルの名前が入っているセルの場所
Sheets("PPM_suppliers").Select
FILE1 = "$E$" & (Action + 1)
FILE2 = "$F$" & (Action + 1)
FILE3 = "$G$" & (Action + 1)
'FILE4 = "$H$" & (Action + 1)

M_MAILtitle = MAIL_title + "(" + S_CODE + " " + S_UNIT + ")"

'添付ファイル名
ATTACH1 = Sheets("PPM_suppliers").Range(FILE1).Value
ATTACH2 = Sheets("PPM_suppliers").Range(FILE2).Value


'添付ファイルのルート

MAIL1 = ThisWorkbook.Path + "\" + "04_PDF file" + "\" + Foldername + "\" + ATTACH1
MAIL2 = ThisWorkbook.Path + "\" + "05_PDF Detail file" + "\" + Foldername + "\" + ATTACH2


'添付ファイルの本文記載
'Addtext = EX1 + "： " + ATTACH1 + vbLf _
+ EX2 + "： " + ATTACH2 + vbLf '+ EX3 + "： " + ATTACH3 + vbLf

'*て先作成のループ**************************************
i = 1
to_addressee = ""
Cc_addressee = ""
Code2 = "Code2"
Do Until Code2 = ""
Sheets("Addressee").Select
Range("B1").Select
Selection.Offset(i, 0).Select
Code2 = ActiveCell.Value

If Code2 = S_CODE Then
Selection.Offset(0, 2).Select
If Not ActiveCell.Value = "" Then
Selection.Offset(0, 1).Select
If to_addressee = "" Then
to_addressee = ActiveCell.Value
Else
to_addressee = to_addressee + vbLf + ActiveCell.Value
End If
Else
Selection.Offset(0, 1).Select
If Cc_addressee = "" Then
Cc_addressee = ActiveCell.Value
Else
Cc_addressee = Cc_addressee + vbLf + ActiveCell.Value
End If
End If
End If

i = i + 1
Loop
'******************************************************

Set OutLookApp = CreateObject("Outlook.Application")
Set NewMail = OutLookApp.CreateItem(olMailItem)
Set MyAttachment = NewMail.Attachments
With NewMail
'.Subject = M_MAIL_title
'.Body = S_CODE + "_" + S_NAME + vbLf + "Dear Sirs/Madams," _
+ vbLf + vbLf + MAILtext1 + "　　" + vbLf _
+ Addtext + vbLf + MAILtext2 + vbLf

If Not to_addressee = "" Then
Set myRecipient = .Recipients.Add(to_addressee)
If Not Cc_addressee = "" Then
Set myRecipient = .Recipients.Add(Cc_addressee)
myRecipient.Type = 2
End If
Else
Set myRecipient = .Recipients.Add(Cc_addressee)
End If

.display
End With

MyAttachment.Add MAIL1
MyAttachment.Add MAIL2
'MyAttachment.Add MAIL3


Next Action


Sheets("menu").Select

RESP = MsgBox("E-mail was made. " _
+ Chr(13) + Chr(10) + Chr(13) + Chr(10) _
+ "Please send to the suppliers. ")

End Sub