Hallo,
mein folgendes Makro soll nur von einigen Usern ausgeführt werden können.
Wenn ein User die Datei per [xurl=
https://supportnet.de/alles-uber-e-mail-ausfuhrlich-erklart-mit-schritt-fur-schritt-anleitungen-fur-die-meisten-anbieter1085/]E-Mail[/url] an die berechtigten User sendet, dann funktioniert das unten stehende Makro nicht mehr.
An dieser Stelle hakt es:
'Datei Öffnen zur Ausgabe
[b] Open Ausgabedatei For Output As #1[/b]
Weiß jemand Rat, wie das Makro geändert werden muß?
Vielen Dank für Eure Hilfe.
Colatrinker
Sub MinSib_EK_Vorgabe()
'
' MinSib_EK_Vorgabe Makro
'
Dim strBlatt As String
Dim Ausgabepfad As String
Dim Ausgabedatei As String
Dim lngSpalte As Long
Dim lngLetzte As Long
Dim z As Long
Dim Zeile As String
Dim VollZeile As String
Dim Trennzeichen As String
'nur diese User dürfen das Makro ausführen
If Environ("UserName") = "ideutz" Then bErlaubt = True
If Environ("UserName") = "swiebers" Then bErlaubt = True
If Environ("UserName") = "amoeller" Then bErlaubt = True
If bErlaubt = False Then
MsgBox "Das Makro darf nicht von " & Environ("UserName") & " ausgeführt werden!", 16, "Unberechtigter User"
Exit Sub
End If
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Variablen festlegen
strBlatt = "MinSib EK-Vorgabe" 'Name des zu exportierenden Arbeitsblattes
Ausgabepfad = "M:\" 'Pfad, in der die Datei exportiert werden soll - anpassen!
Trennzeichen = ";" 'Trennzeichen wird festgelegt
'Ausgabepfad und Dateinamen für Ausgabedatei erstellen - Ausgabename anpassen
Ausgabedatei = Ausgabepfad & "minbestaende_" & Worksheets("Beipackzettel").Range("C4").Value & ".csv"
'letzte Zeile des Tabellenblatts ermitteln
lngLetzte = Worksheets(strBlatt).Cells(Rows.Count, 26).End(xlUp).Row
'Falls Ausgabedatei bereits besteht, wird diese gelöscht
If Dir(Ausgabedatei) <> "" Then Kill (Ausgabedatei)
'Datei Öffnen zur Ausgabe
[b] Open Ausgabedatei For Output As #1[/b]
For z = 1 To lngLetzte
'Nur die Spalten Z bis AB werden exportiert
For lngSpalte = 26 To 28
Zeile = Trim(Worksheets(strBlatt).Cells(z, lngSpalte).Text)
Zeile = Replace(Zeile, Trennzeichen, "") 'ggf in Text vorkommendes Trennzeichen wird gelöscht
VollZeile = VollZeile & Zeile & Trennzeichen
Next lngSpalte
'Ausgabe in Datei
VollZeile = Left(VollZeile, Len(VollZeile) - 1) 'Letzten Semicolon abschneiden
If Len(Replace(VollZeile, Trennzeichen, "")) > 0 Then Print #1, VollZeile
VollZeile = ""
Next z
Close #1 'Datei schliessen
'Bildschirmaktualisierung
If Application.Ready Then
Application.ScreenUpdating = True
End If
'Abschlussmeldung
MsgBox "MinSib EK-Vorgabe gespeichert; an REWA denken!", 64
End Sub
