Login bei Sub SaveAsXLSX

Forumthread: Login bei Sub SaveAsXLSX

21.06.2021 10:44:54

Alex

Hallo ich benötige Hilfe :)
Ich würde dem unten aufgeführten Code gerne sagen das bevor er Speichert sich in das Netzwerklaufwerk einloggt mit User und PW.
Kann mir dabei Bitte jemand behilflich sein ? Danke


Sub SaveAsXLSX()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Tabelle1 (2)").Select
Sheets("Tabelle1 (2)").Copy
'Datei ohne Makros (als XLSX-Datei) speichern
Application.DisplayAlerts = False 'Fehlermeldungen aus
'hier mit direkter Pfadangabe
ActiveWorkbook.SaveAs "\\10.171.145.150\data$\XXXX.xlsx", _
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True ' Fehlermeldungen an
Windows("XXXX.xlsx").Activate
ActiveWindow.Close
Sheets("1").Select
ActiveWorkbook.save
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Login bei Sub SaveAsXLSX

21.06.2021 14:28:55

Alex
AW: Login bei Sub SaveAsXLSX

21.06.2021 19:13:25

Yal

AW: Login bei Sub SaveAsXLSX

21.06.2021 14:28:55

Alex

Lässt sich das irgendwie mit dem obrigen Code verbinden ?


Sub LOGIN_DIGI(strLFW As String)
Dim strServer As String
Dim strUser As String
Dim strPass As String
Dim strCommand As String
strServer = "\\10.171.145.150\data$\SchichtTkocz.xlsx"
strUser = "XXXX"
strPass = "XXXX"
strCommand = "net use " & strLFW & " " & strServer & " " & strPass & " /user:" & strUser
Shell strCommand
End Sub

AW: Login bei Sub SaveAsXLSX

21.06.2021 19:13:25

Yal

hallo Alex,
versuche lieber damit:


Sub Laufwerk_anbinden()
Dim oNwk As Object
Set oNwk = CreateObject("WScript.Network")
'Netzlaufwerk verbinden auf "B:"(zu 99,99% frei)
On Error GoTo fehler
oNwk.MapNetworkDrive "B:", "\\server1\freigabe", , "benutzer", "passwort"
'mach was
'Netzlaufwerk trennen
'oNwk.RemoveNetworkDrive "B:"
Set oNwk = Nothing
Exit Sub
fehler:
MsgBox Err.Number & vbCr & Err.Description
'  Resume Next
Set oNwk = Nothing
End Sub

Prüfen, ob eine Laufwerk-Buchstabe frei ist, kannst Du wie folgt:


Public Function Drive_exists(Buchstabe) As Boolean
'Unter Anbindung von "Microsoft Scripting Runtime"
Dim FSO As New FileSystemObject
On Error Resume Next
Drive_exists = Not (FSO.Drives(Buchstabe) Is Nothing)
End Function

Solltest Du aber sofort die erste freie laufwerk-Buchstabe ermitteln wollen:


Private Function FreieBstb_ermitteln() As String
'Unter Anbindung von "Microsoft Scripting Runtime" (Extras, Verweise... )
Dim FSO As New FileSystemObject
Dim i
On Error Resume Next
For i = 65 To 90
If FSO.Drives(Chr(i)) Is Nothing Then
FreieBstb_ermitteln = i
Exit Function
End If
Next
End Function

!: Unter Anbindung von "Microsoft Scripting Runtime" (Extras, Verweise... )
VG
Yal

Beliebteste Forumthreads (12 Monate)

Forumthread: Login bei Sub SaveAsXLSX

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread