Object variable or With block not set hatası

[spasmex97]

Öncelikle merhabalar, bir excel dosyası üzerinde filtrelediğim PDF isimlerini kullanarak bunların URL sini bir sütuna yazdırıyorum, amacım bu URL leri kullanarak toplu bir şekilde çıktı almak. Tıkandığım nokta ise döng aşağıda yazan kod içinde

If Sh Is Nothing Then Set Sh = CreateObject("Shell.Application")

kısmında " Object variable or With block not set" hatası vermesi, 2 gündür arıyorum çözüm bulamadım.

Public Sub Print_PDFs()

    Dim PDFsFolder As String
    Dim PDFfile As String
    Dim r As Long
  
    PDFsFolder = "\\192.168.1.191\04-proje$\Teknik Resimler\Fkt Teknik Resimler\"      'CHANGE THIS
  
    If Right(PDFsFolder, 1) <> "\" Then PDFsFolder = PDFsFolder & "\"
  
    With Sheets("siparis")
        For r = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            PDFfile = PDFsFolder & .Cells(r, "G").Value & ".pdf"
            If PDFfile <> vbNullString Then
                Print_PDF PDFsFolder & PDFfile
            End If
        Next
    End With
  
End Sub


Private Sub Print_PDF(PDFfile As String)
 
    Static Sh As Object 'Shell32.Shell

    
    Dim folder As Variant, fileName As Variant
  
    folder = Left(PDFfile, InStrRev(PDFfile, "\"))
    fileName = Mid(PDFfile, InStrRev(PDFfile, "\") + 1)
  
    If Sh Is Nothing Then Set Sh = CreateObject("Shell.Application")
    Sh.Namespace(folder).Items.Item(fileName).InvokeVerb "Print"

End Sub

 

[Muzaffer Ali]

Bir sorun görünmüyor fakat aşağıdaki gibi de deneyebilirsiniz.
Eğer yine de olmazsa dosyanızı ekleyin kontrol edelim.

Dim Sh As Object 'Shell32.Shell

Public Sub Print_PDFs()
    Dim PDFsFolder As String
    Dim PDFfile As String
    Dim r As Long
    Set Sh = CreateObject("Shell.Application")
    PDFsFolder = "\\192.168.1.191\04-proje$\Teknik Resimler\Fkt Teknik Resimler\"      'CHANGE THIS
    If Right(PDFsFolder, 1) <> "\" Then PDFsFolder = PDFsFolder & "\"
    With Sheets("siparis")
        For r = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            PDFfile = PDFsFolder & .Cells(r, "G").Value & ".pdf"
            If PDFfile <> vbNullString Then
                Print_PDF PDFsFolder & PDFfile
            End If
        Next
    End With
End Sub

Private Sub Print_PDF(PDFfile As String)
    Dim folder As Variant, fileName As Variant
    folder = Left(PDFfile, InStrRev(PDFfile, "\"))
    fileName = Mid(PDFfile, InStrRev(PDFfile, "\") + 1)
    Sh.Namespace(folder).Items.Item(fileName).InvokeVerb "Print"
End Sub

 

[spasmex97]

Bir sorun görünmüyor fakat aşağıdaki gibi de deneyebilirsiniz.
Eğer yine de olmazsa dosyanızı ekleyin kontrol edelim.

Dim Sh As Object 'Shell32.Shell

Public Sub Print_PDFs()
    Dim PDFsFolder As String
    Dim PDFfile As String
    Dim r As Long
    Set Sh = CreateObject("Shell.Application")
    PDFsFolder = "\\192.168.1.191\04-proje$\Teknik Resimler\Fkt Teknik Resimler\"      'CHANGE THIS
    If Right(PDFsFolder, 1) <> "\" Then PDFsFolder = PDFsFolder & "\"
    With Sheets("siparis")
        For r = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            PDFfile = PDFsFolder & .Cells(r, "G").Value & ".pdf"
            If PDFfile <> vbNullString Then
                Print_PDF PDFsFolder & PDFfile
            End If
        Next
    End With
End Sub

Private Sub Print_PDF(PDFfile As String)
    Dim folder As Variant, fileName As Variant
    folder = Left(PDFfile, InStrRev(PDFfile, "\"))
    fileName = Mid(PDFfile, InStrRev(PDFfile, "\") + 1)
    Sh.Namespace(folder).Items.Item(fileName).InvokeVerb "Print"
End Sub

yoğunluktan dolayı anca bakabildim kusura bakmayın, fakat aynı hatayı vermeye devam ediyor