Код не работает в MA C Book и выдает ошибку - PullRequest
Новая
       36

Код не работает в MA C Book и выдает ошибку

0 голосов
/ 07 августа 2020

Кто-нибудь может рассказать, как код будет работать в MA C. Этот код отлично работает в windows, но всякий раз, когда я запускаю его в MA C, он не работает, выдает ошибку, пожалуйста, решите проблему. Не знаю, почему выдает ошибку при работе в MA C. У моего windows есть Office 2016, а у MA C есть Office 365. Но он работает на windows office 365 может быть MA C настройки создают проблему. 

    Sub singlepdf()

ThisWorkbook.Sheets("PDF").Range("C7").Value = ThisWorkbook.Sheets("Instructions").Range("D12").Value
If ThisWorkbook.Sheets("Instructions").Range("D12") = "" Then
MsgBox ("Please Enter Student Name in Cell D12")
Exit Sub
Else

Dim sFolderpath As String
FolderName = ThisWorkbook.Sheets("PDF").Range("C7").Value & " " & Format(Now(), "dd.mm.yy hh.mm")
sFolderpath = ThisWorkbook.Path & "\" & FolderName
MkDir sFolderpath
ChDir sFolderpath

Dim sPath As String
sPath = sFolderpath
Filename = ThisWorkbook.Sheets("PDF").Range("C7").Value & " Feedback Form "
ThisWorkbook.Sheets("PDF").ExportAsFixedFormat xlTypePDF, sPath & "\" & Filename

End If
MsgBox ("Pdf Saved")
End Sub

Sub sessionpdf()
If ThisWorkbook.Sheets("Instructions").Range("D11") = "" Then
MsgBox ("Please Enter Session timing in Cell D11")
Exit Sub
Else

Dim sFolderpath2 As String
FolderName2 = ThisWorkbook.Sheets("Instructions").Range("D11").Value & " " & Format(Now(), "dd.mm.yy hh.mm")
sFolderpath2 = ThisWorkbook.Path & "\" & FolderName2
MkDir sFolderpath2
ChDir sFolderpath2

 a = 1
 b = WorksheetFunction.CountA(ThisWorkbook.Sheets("Child + Parent List").Range("F2:F1000"))
 Do While a <= b
  session = ThisWorkbook.Sheets("Child + Parent List").Range("E1").Offset(a, 0).Value
  If session = ThisWorkbook.Sheets("Instructions").Range("D11").Value Then
  studentname = ThisWorkbook.Sheets("Child + Parent List").Range("C1").Offset(a, 0).Value
  ThisWorkbook.Sheets("PDF").Range("c7").Value = studentname
  Filename = studentname & " " & Format(Now(), "dd.mm.yy hh.mm") & " Feedback Form "
  ThisWorkbook.Sheets("PDF").ExportAsFixedFormat xlTypePDF, sFolderpath2 & "\" & Filename
  Else
  End If
  a = a + 1
  Loop

End If
MsgBox ("Mulitple PDFs Saved")
End Sub

Sub emailsinglepdf()

Dim Oapp As Outlook.Application
Dim Omail As Object
ThisWorkbook.Sheets("PDF").Range("C7").Value = ThisWorkbook.Sheets("Instructions").Range("D12").Value
If ThisWorkbook.Sheets("Instructions").Range("D12") = "" Then
MsgBox ("Please Enter Student Name in Cell D12")
Exit Sub
Else

If ThisWorkbook.Sheets("instructions").Range("F12") = "" Then
MsgBox ("Please enter student email in Child +ParentList")
Exit Sub


ElseIf ThisWorkbook.Sheets("Instructions").Range("f12") = "0" Then
MsgBox ("Please enter student email in Child +ParentList")
Exit Sub

Else
Filename = ThisWorkbook.Sheets("PDF").Range("C7").Value & " Feedback Form"
ThisWorkbook.Sheets("PDF").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Filename

  Set Oapp = New Outlook.Application
  Set Omail = Oapp.CreateItem(0)
  
  Oapp.session.Logon
  With Omail
       .To = ThisWorkbook.Sheets("Instructions").Range("F12").Value
       .CC = ""
       .Subject = "Scoresheet of " & ThisWorkbook.Sheets("Instructions").Range("D12").Value
       .Body = "Testing Purpose"
       .Attachments.Add (ThisWorkbook.Path & "\" & Filename & ".pdf")
       .Send
 End With
  

  Set Oapp = Nothing
  Set Omail = Nothing
   Kill (ThisWorkbook.Path & "\" & Filename & ".pdf")

End If
End If
MsgBox ("Pdf Sent")
End Sub

Sub emailsessionpdf()

Dim Oapp As Outlook.Application
Dim Omail As Object
If ThisWorkbook.Sheets("Instructions").Range("D11") = "" Then
MsgBox ("Please Enter Session timing in Cell D11")
Exit Sub
Else

 a = 1
 b = WorksheetFunction.CountA(ThisWorkbook.Sheets("Child + Parent List").Range("F2:F1000"))
  
Dim session As String
 Do While a <= b
  
   session = ThisWorkbook.Sheets("Child + Parent List").Range("E1").Offset(a, 0).Value
  If session = ThisWorkbook.Sheets("Instructions").Range("D11").Value Then
  studentname = ThisWorkbook.Sheets("Child + Parent List").Range("C1").Offset(a, 0).Value
  ThisWorkbook.Sheets("PDF").Range("c7").Value = studentname
  studentemail = ThisWorkbook.Sheets("Child + Parent List").Range("A1").Offset(a, 0).Value
  Filename = studentname & " " & Format(Now(), "dd.mm.yy hh.mm") & " Feedback Form "
  ThisWorkbook.Sheets("PDF").ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Filename
  Else
  End If
  
  If studentemail <> "" Then
  Set Oapp = New Outlook.Application
  Set Omail = Oapp.CreateItem(0)
  Oapp.session.Logon
  With Omail
       .To = studentemail
       .CC = ""
       .Subject = "Scoresheet of " & studentname
       .Body = "Testing Purpose"
       .Attachments.Add (ThisWorkbook.Path & "\" & Filename & ".pdf")
       .Send
 End With
  

  Set Oapp = Nothing
  Set Omail = Nothing
   Kill (ThisWorkbook.Path & "\" & Filename & ".pdf")
  End If
  
  
a = a + 1
Loop
End If
MsgBox ("Mulitple emails sent")
End Sub
...