- Copy internal post link
- Copy external post link
- Report article
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html
[content:35946]
Kein Zugriff auf Datei nach speichern im Dateisystem (VBA?!)
Ein Worddokument wird per Makro auf dem Server abgelegt (gespeichert). Da es aber noch geöffnet ist kann ein Prozess auf dem Server nicht auf das Dokument zugreifen und es verarbeiten.
kurz um >> Das Worddokument schließen ohne es wirklich zu schließen ;)
Am besten das ganze per vba-makro....
wenn jemand eine idee hat wäre das super!
Content-Key: 35946
Url: https://administrator.de/contentid/35946
Printed on: May 8, 2024 at 03:05 o'clock
- Comment overview - Please log in
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html#comment-157487
[content:35946#157487]
Reicht ein .Document.Save nicht?
Ich würde die Word-Datei im reinen Nur-Lese-Modus öffnen im neuen Prozess.
Wenn ich überhaupt etwas davon "lesen" will.
Was soll den das hehre Ziel dieses Serverprozesses sein?
Gruß
Biber
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html#comment-157657
[content:35946#157657]
klingt alles ein wenig kompliziert, klappt aber eigentlich schon ganz gut, nur eben an dem punkt, wo das archivsystem das erzeugte xml-file schnappt und zusammen mit dem word-dokument verarbeiten will hakt es, weil das word dokument ja noch beim user geöffnet ist.
das ding ist nur, es soll ja auch beim user geöffnet bleiben, damit er weiter dran arbeiten kann. jedesmal, wenn er das archivierungsmakro ausführt bekommt die datei einen neuen timestampnamen. somit ist es möglich immer wieder eine neuere versin des dokumentes im archiv abzulegen.
und zum schluss:
erst beim erneuten ausführen des makros wird ja die "alte" dokumentversion geschlossen und eine neue auf dem server angelegt, somit kann nun die alte version verarbeitet werden. der user soll aber nicht 2 mal auf das makro klicken um die als erstes erzeugte version ins archiv zu bekommen.
die lösung:???
meine idee wäre nun den kram zuerst in einem zwischenordner zu speichern und nach dem speichern die dateien in den eigentlichen zielordner zu kopieren. nach der zeit x wird der zwischen ordner per task geleert (z.b. nachts um 24 uhr, dann erwischt man hoffentlich keine "noch nicht in den zielordner verschobenen dateien".
das ganze ist aber recht umständlich und deswegen soll das ja auch irgenwie per makro klappen, das ich dem rechner, ähnlich wie im unixsystem, die datei untern hintern wegziehe, obwohl er sie noch offen hat...
MfG - Steffen
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html#comment-157716
[content:35946#157716]
kann man den kopiervogang erzwingen?
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html#comment-157720
[content:35946#157720]
Doc zu kopieren, allerdings verweigert er mir
den zugriff auf das doc!!!!
kann man den kopiervogang erzwingen?
Kannst Du denn von diesem Makro bzw. von der letzten Erweiterung mal die relevanten Zeilen posten bitte?
Das ist mir so (noch) zu abstrakt.
Danke
Biber
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/kein-zugriff-auf-datei-nach-speichern-im-dateisystem-vba-35946.html#comment-157753
[content:35946#157753]
hab trick 17 angewendet, auch wenn das nicht die beste variante ist.
ich speichere das dok einfach sofort ein 2.mal mit einem anderem namenszusatz, dann kann ich die erste version weiterverarbeiten.
der gesamte makrocode sieht so aus (sollte auch in einem blanko dokument funzen):
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Sub Archiv()
Dim Sektion$, ApplicationTag$, Sender$, File$, Zielpfad$, Zwischenablage$, Steuerdateierweiterung$, Dateiname_hps$, Nrtype$
'------------- Parameterbelegung ------------------
'Speicherpfad für beide Dateien (HPS und DOC)
Zielpfad = "\\testserver\testverzeichnis\"
Zwischenablage = "\\testserver\testverzeichnis\Zwischenablage\"
Steuerdateierweiterung = "hps"
'---------------------------------------------------
'Auslesen des Bereiches zwischen 2 Textmarken
Dim Textmarke_1, Textmarke_2, Textmarke_3, Textmarke_4
'Textmarken, zwischen denen der Text ausgewählt wird
Textmarke_1 = "KUNDENNR"
Textmarke_2 = "KUNDENNR_ENDE"
Textmarke_3 = "LIEFERANTENNR"
Textmarke_4 = "LIEFERANTENNR_ENDE"
'########## Prüfen ob Kunde ############################
Dim kDoc As Document
Dim kRange As Range
Set kDoc = ActiveDocument
If kDoc.Bookmarks.Exists(Textmarke_1) And kDoc.Bookmarks.Exists(Textmarke_2) Then
Set kRange = kDoc.Range(Start:=kDoc.Bookmarks(Textmarke_1).Range.Start, End:=kDoc.Bookmarks(Textmarke_2).Range.Start)
kRange.Select
'Wenn Kundennummer gefunden wurde
If kRange <> " " And kRange <> "" Then
Nrtype = "Kunde"
'MsgBox (kRange)
Call Titel(Zielpfad, Zwischenablage, Steuerdateierweiterung, kRange, Nrtype)
Else
'########## Prüfen ob Lieferant #######################
Dim lDoc As Document
Dim lRange As Range
Set lDoc = ActiveDocument
If lDoc.Bookmarks.Exists(Textmarke_3) And lDoc.Bookmarks.Exists(Textmarke_4) Then
Set lRange = lDoc.Range(Start:=lDoc.Bookmarks(Textmarke_3).Range.Start, End:=lDoc.Bookmarks(Textmarke_4).Range.Start)
lRange.Select
'Wenn Lieferantennummer gefunden wurde
If lRange <> " " And lRange <> "" Then
Nrtype = "Lieferant"
'MsgBox (NrType)
Call Titel(Zielpfad, Zwischenablage, Steuerdateierweiterung, lRange, Nrtype)
Else
'####### wenn keine KDNR und keine LFRNR gefunden wird ####################
Nrtype = "Unbekannt"
Call Case_manuell(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
End If
Else
'####### Falls keine Textmarken nach Lieferantensuche gefunden werden #######################
Call Case_manuell(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
End If
End If
Else
'####### Falls keine Textmarken gefunden werden ###########
Call Case_manuell(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
End If
End Sub
Function Case_manuell(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
Dim Mldg, Stil, Titel, Hilfe, Ktxt, Antwort, Text1
Mldg = "Es wurden keine Textmarken gefunden" & vbCrLf & "Soll eine manuelle Zuweisung vorgenommen werden?"
Stil = vbYesNo + vbCritical + vbDefaultButton1
Titel = "Fehler beim Auslesen der Textmarken"
Antwort = MsgBox(Mldg, Stil, Titel)
If Antwort = vbYes Then
Call Neue_Nummer(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
Else
End If
End Function
Function Neue_Nummer(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nrtype)
'Nach Nummerfragen
Dim manuelle_Nummer
manuelle_Nummer = InputBox("Keine Kundennummer oder Lieferantennummer gefunden." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Bitte Nummer eingeben.", "Manuelle Nummerzuweisung für " & Nrtype, "")
If manuelle_Nummer = "" Then
manuelle_Nummer = " "
End If
Call Titel(Zielpfad, Zwischenablage, Steuerdateierweiterung, manuelle_Nummer & " ", Nrtype)
End Function
Function Titel(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nummer, Nrtype) As Variant
'Name des Dokuemtes eingeben
Dim DocName
DocName = InputBox("Bitte Dokumentname eingeben:", "Dokumentname für Schreiben an " & Nrtype & " (Nr." & Nummer & ")", "neues Dokument")
If DocName = "" Then
DocName = "Neues Dokument"
End If
'Nochmal fragen ob Dokument wirklich ins Archiv geschoben werden soll
Dim Archivantwort
Archivantwort = MsgBox("Möchten Sie das Dokument wirklich ins Archiv einfügen?", vbYesNo + vbQuestion + vbDefaultButton1, "Einfügen bestätigen")
If Archivantwort = vbYes Then
'speichern
Call Speichern(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nummer, DocName)
Else
'nix
End If
End Function
Function Speichern(Zielpfad, Zwischenablage, Steuerdateierweiterung, Nummer, DocName) As Variant
'Variablen zum Speichern
Dim Sektion$, ApplicationTag$, Sender$, File$
'Dateipfad und Name fuer HPS und DOC aus Datum basteln
Dim Part(1 To 3) As String
Part(1) = Zwischenablage
Part(2) = Format(Date, "yyyymmdd") + "_" + Format(Time, "hhmmss")
Part(3) = "." & Steuerdateierweiterung
Dateiname_hps = Part(1) & Part(2) & Part(3)
'MsgBox (Dateiname_hps)
'Erste Zeile (mit eckigen Klammern)
Sektion = "[Info]"
'ApplicationTag
ApplicationTag = "ApplicationTag=" & Nummer & DocName
'MsgBox (ApplicationTag)
'Sender
Sender = "Sender=" & Environ("Username")
'MsgBox (Sender)
'File
File = "File=" & Part(2) & ".doc"
'MsgBox (File)
'HPS schreiben
Open Dateiname_hps For Append As 1
Print #1, Sektion$
Print #1, ApplicationTag$
Print #1, Sender$
Print #1, File$
Close #1
'Dokumentpfad und Name der Word-Datei aus Datum basteln
Dim Part_doc(1 To 3) As String
Part_doc(1) = Zwischenablage
Part_doc(2) = Part(2)
Part_doc(3) = ".doc"
Dateiname_doc = Part_doc(2) & Part_doc(3)
'DOC schreiben in Zwischenablageordner
ChangeFileOpenDirectory Part_doc(1)
ActiveDocument.SaveAs FileName:=Dateiname_doc, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
'DOC schreiben in Zwischenablageordner mit Namenszusatz "_saved"
Dim Dateiname_Saved
Dateiname_Saved = Part_doc(2) & "_saved" & Part_doc(3)
ChangeFileOpenDirectory Part_doc(1)
ActiveDocument.SaveAs FileName:=Dateiname_Saved, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
'von der Zwischenablage in den Zielpfad kopieren
Dim Datei_hps
Datei_hps = Part(2) & Part(3)
Call Copy_to_Target(Zwischenablage, Zielpfad, Datei_hps, Dateiname_doc)
End Function
Function Copy_to_Target(Zwischenablage, Zielpfad, Datei_hps, Dateiname_Dokument)
'HPS und DOC kopieren
FileCopy Zwischenablage & Datei_hps, Zielpfad & Datei_hps
FileCopy Zwischenablage & Dateiname_Dokument, Zielpfad & Dateiname_Dokument
'HPS und DOC aus Zwischenablageordner löschen (nur geöffnetes DOC ist noch da!)
Kill Zwischenablage & Datei_hps
Kill Zwischenablage & Dateiname_Dokument
End Function
verbesserungsvorschläge??
ist natürlich ein bissel umständlich 2 mal was zu speichern und es nach dem kopieren wieder zu löschen, aber immerhin klappt es! ;)
die restlichen "leichen" aus dem zwischenablagenordner kanni ich ja nachts (wenn hoffentlich kein mitarbeiter mehr ein dok offen hat) per task löschen lassen...
;)