dr.cornwallis
Goto Top

VBA Skript funktioniert auf lokalen Zugriff, aber nicht auf Netzwerkshare

Hallo zusammen,

ich würde gerne ein Excel Makro automatisiert starten(Task sheduler), das funktioniert lokal auch soweit.
Wenn ich die Excel nun auf eine Share lege und die Pfade anpasse, funktioniert es nicht mehr.
Fehlermeldung:
Auch wenn ich die Share Mappe(mit Laufwerksbuchstabe) und diesen Pfad dann einfüge, funktioniert es ebenfalls nicht...

Excel kann auf die Datei xxx.xlsm nicht zugreifen. Dies kann mehrere Gründe haben.......
Code: 800A03EC

Der Task sheduler führt ein .vbs Skript aus, dieses öffnet dann das Workbook und führt das Makro aus.

Kann es auch sein dass der Prozess nicht auf die Share zugreifen kann(Berechtigungsproblem)?

Hier das Skript(Namen verändert):
    ' Create a WshShell to get the current directory  
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")  

' Create an Excel instance  
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")   

' Disable Excel UI elements  
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone

' Tell Excel what the current working directory is   
' (otherwise it can't find the files)  
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = "\\Server\share"  
myExcelWorker.DefaultFilePath = strPath

' Open the Workbook specified on the command-line   
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\meine_Excel.xlsm"  

Set oWorkBook = myExcelWorker.Workbooks.Open(strWorkerWB)

' Build the macro name with the full path to the workbook  
Dim strMacroName
strMacroName = "'" & strPath & "\meine_Excel.xlsm'" & "!SendMail.AttachActiveSheetPDF"  
on error resume next 
   ' Run the calculation macro  
   myExcelWorker.Run strMacroName
   if err.number <> 0 Then
      ' Error occurred - just close it down.  
   End If
   err.clear
on error goto 0 
 
' Clean up and shut down  
Set oWorkBook = Nothing

' Don’t Quit() Excel if there are other Excel instances   
' running, Quit() will   

if myExcelWorker.Workbooks.Count = 0 Then
   myExcelWorker.Quit
End If

Set myExcelWorker = Nothing
Set WshShell = Nothing

Excel Makro/Modul:
Option Explicit

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is  
  Title = Range("A1")  
 
  ' Define PDF filename  
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")  
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"  
 
  ' Export activesheet as PDF  
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible  
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment  
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail  
    .Subject = "blabla"  
    .To = "blabla@domain.de"  
    .Body = "Hallo @all," & vbLf & vbLf _  
          & "blabla." & vbLf & vbLf _  
          & "MfG" & vbLf _  
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send  
    On Error Resume Next
    .Send
    Application.Visible = False

    On Error GoTo 0
   
  End With
 
  ' Delete PDF file  
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code  
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable  
  Set OutlApp = Nothing
 
End Sub

Danke für eure Hilfe!

Gruß

Dr.

Content-Key: 314144

Url: https://administrator.de/contentid/314144

Printed on: April 26, 2024 at 08:04 o'clock

Member: Dr.Cornwallis
Dr.Cornwallis Sep 01, 2016 at 13:41:09 (UTC)
Goto Top
Hat sich erledigt, es lag an den Umlauten im Pfad(keine Ahnung warum man das macht), Datei verschoben, Pfade im Skript angepasst und schon läufts face-smile


Gruß Dr.