Changing VBA code 2003 to 2013

merveak

New Member
Joined
Jan 20, 2016
Messages
12
Hello members,

Can someone help me about the following codes written on VBA 2003? It does not working on 2013. I think filesearch..etc is no more available.

Sub gonder()
Dim ek As Object
Dim objOlk As Object, evn As Object, strresmim As String
Dim objEkle As Object, objevn As Object, evngovde As String
Rem Www.ExcelVBA.Net - 29.06.2010 - Tarkan VURAL
strresmim = "C:\Documents and Settings\ksy05\Desktop\svkyt\svk rpr2.jpg"
Sheets("form").Unprotect Password:="0000"
Sheets("form").[a1:aa20].CurrentRegion.CopyPicture xlScreen, xlBitmap
Set ek = ActiveSheet.ChartObjects.Add(, , 2000, 700).Chart
ek.Paste
ek.Export strresmim
ek.Parent.Delete
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Sheets("mail").[a3].Value
evn.CC = [h2].Value
evn.BCC = [h3].Value
evn.Subject = [h4].Value
evngovde = Sheets("form").[A1].Value & "<br>" & Sheets("form").[aa20].Value
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.Save
evn.Display
evn.Send
strresmim = vbNullString
Sheets("form").Protect Password:="0000"
Set evn = Nothing: Set objOlk = Nothing
Set objevn = Nothing: Set objEkle = Nothing
evngovde = vbNullString: Set ek = Nothing
End Sub



Dim rng As Range

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If



.HTMLBody = RangetoHTML(rng) & imza
'.Signature = imza
With Application.FileSearch
.LookIn = sPDFPath 'arama yapılan dizin
.SearchSubFolders = False 'alt klasörler aransın mı
'.FileType = msoFileTypeExcelWorkbooks aranacak dosya türleri
.Filename = "*.pdf" 'aranacak dosya isimleri/uzantıları
If .Execute() > 0 Then
'MsgBox .FoundFiles.Count & " adet dosya bulundu."
For i = 1 To .FoundFiles.Count
OutMail.Attachments.Add .FoundFiles(i)
Next i
Else
MsgBox "Hiç dosya bulunamadı.", vbCritical
End If
End With

.Display

'.Text = "Konu kisminda belirtilen dokumanlarin dagitimi ilgili bolumlere yapilmistir.OK/Onay maili donulmesi."
End With
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("sevkler").Protect Password:="0000"
ThisWorkbook.Save
' SendKeys "^v"
End Sub

Thanks in advance!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Forum statistics

Threads
1,215,339
Messages
6,124,362
Members
449,155
Latest member
ravioli44

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top