How to change VBA code for excel 2013

[merveak]

Hello All,

I have a VBA code that is written for excel 2003. Now we work with Excel 2013 and the code does not work.
I do not have any experience about VBA codes. Any help is appreciated!

Code:

"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"

 

[pbornemeier]

I believe this code will replace the code you have posted above. Test on a copy of your workbook.

Dim ofldr As Object
Dim ofile As Object
Dim FSO As Object
Dim varyFiles() As Variant
Dim lFileIndex As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set ofldr = FSO.GetFolder(sPDFPath)

If ofldr.Files.Count > 0 Then
    For Each ofile In ofldr.Files
        If UCase(Mid(ofile.shortname, InStrRev(ofile.shortname, ".") + 1)) = "PDF" Then
            lFileIndex = lFileIndex + 1
            ReDim Preserve varyFiles(1 To lFileIndex)
            varyFiles(lFileIndex) = ofile.Path
        End If
    Next
End If

If lFileIndex > 0 Then
    For i = 1 To lFileIndex
        OutMail.Attachments.Add varyFiles(lFileIndex)
    Next i
    Else
        MsgBox "Hiç dosya bulunamadi.", vbCritical
    End If
End If
    
.Display

'.Text = "Konu kisminda belirtilen dokumanlarin dagitimi ilgili bolumlere yapilmistir.OK/Onay maili donulmesi."
End With

Set ofldr = Nothing
Set FSO = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

Sheets("sevkler").Protect Password:="0000"
ThisWorkbook.Save
' SendKeys "^v"

End Sub

 

[merveak]

Dear Phil,

Thank you very much! It Worked! You made my day!!

Merve