Datei per Makro auf Sharepoint speichern
11.12.2020 13:56:02
Pare
bisher konnte ich immer nur passiv aber dafür schon sehr gut von diesem Forum profitieren. Zunächst vielen Dank dafür!
Jetzt bin ich aber auf eine Herausforderung gestoßen, auf die ich leider keine Lösung aus anderen Beiträgen finden konnte. Deshalb verfasse ich nun selber meinen ersten Beitrag. Zu meinen VBA-Kenntnissen, diese sind noch sehr ausbaufähig. Bitte in den Antworten berücksichtigen. Danke!
Nun zu meinem Problem:
Ich habe eine Exceldatei erstellt (ein Bestellformular). Dieses soll per Schaltfläche, nachdem bestimmte Pflichtfelder gefüllt sind, an eine E-Mail Adresse als Anhang versendet werden und zusätzlich mit einem neuen Namen überschrieben und im selben Ordner abgelegt werden, in dem die Ursprungsdatei lag. Dies hat alles soweit gut geklappt.
Nun soll die Datei jedoch nicht lokal, sondern auf einem Sharepoint liegen und hier beginnt mein Problem. Nämlich schaffe ich es nicht, die Datei in dem Ordner zu speichern, wo sie davor lag. Wichtig hierbei ist noch, dass ich nicht einen festen Pfad in den Code schreiben kann, da sich dieser immer wieder wechseln wird.
Ich habe versucht mit ActiveWorkbook.Path zu arbeiten, jedoch funktionierte das bisher leider nicht.
Ich könnte mir vorstellen, dass diese Fragestellung schon bei einigen aufgetaucht ist und hoffentlich kann mir hier jemand weiterhelfen. Danke schon mal!
VG
Anbei mein Code. Meiner Meinung nach wird dieser ab dem Ausdruck: Pfad = ActiveWorkbook.Path für meine Fragestellung relevant.
Sub Schaltfläche1_Klicken()
Dim aws As String
Dim olapp As Object
Dim zeile As Long, OK As Boolean
OK = True
For zeile = 16 To 39 'Prüft ob Pflichtfelder befüllt sind
If Tabelle1.Cells(zeile, 3).Value "" Then
If Tabelle1.Cells(7, 5).Value = "" Then OK = False
If Tabelle1.Cells(7, 22).Value = "" Then OK = False
If Tabelle1.Cells(8, 5).Value = "" Then OK = False
If Tabelle1.Cells(zeile, 3).Value = "" Then OK = False
If Tabelle1.Cells(zeile, 4).Value = "" Then OK = False
If Tabelle1.Cells(zeile, 14).Value = "" Then OK = False
If Tabelle1.Cells(zeile, 18).Value = "" Then OK = False
If Tabelle1.Cells(41, 5).Value = "" Then OK = False
If Tabelle1.Cells(42, 5).Value = "" Then OK = False
If Tabelle1.Cells(42, 22).Value = "" Then OK = False
End If
Next
If Not OK Then
MsgBox "Senden nicht möglich - Bitte füllen Sie alle hellroten Pflichtfelder aus!"
Cancel = True
Exit Sub
End If
Pfad = ActiveWorkbook.Path
'ActiveWorkbook.ActiveSheet.Copy 'später auskommentieren im Echtbetrieb
ActiveWorkbook.SaveAs (Pfad & "KW" & Range("c14").Value & "_" & Range("n16").Value & "_" & _
Range("r16").Value) 'Speichert die Kopie
awb = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application") 'Erstellt eine Outlooksession
With olapp.CreateItem(0)
.To = Range("d5").Value 'Empfänger
.Subject = "Bestellung KW" & Range("c14").Value & "_" & Range("n16").Value & "_" & Range( _
_
"r16").Value) 'Betreff
.htmlBody = "Bitte bestätigen Sie die Bestellung bis zum " & Range("z1").Value & " an _
die E-Mail Adresse des Absenders." 'Text
.Attachments.Add awb 'Anhang
.Display
End With
'ActiveWorkbook.Close 'Schließt die Kopie
End Sub