FileSystemObject? HTTPS Link?
Jessi
ich habe mal wieder ein Problem.
Ich habe die ganze Zeit mit einem Link auf der lokalen Festplatte gearbeitet. Wollte das Ganze jetzt auf einen MOSS-SERVER schieben und den Code nochmal durchlaufen lassen. Funktioniert aber nicht?
Wie kann ich einen HTTPS (M O S S - Server) hier integrieren?
Danke vorab!!!
Hier mein Code:
Sub Schaltfläche1_KlickenSieAuf()
Dim Fso, Ordner, varDatei
Dim DateiName As String, tempStrDatei As String, tempName As String
Dim i As Long
Dim Bereich As Range
ActiveSheet.Cells(1, 4).Value = Now
Set Bereich = Range("E4:S4") 'hier Bereich Gewerke
'ab welcher Zeile einfügen
i = 5
lngCol = 1 'für Teilergebnisse
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ordner = Fso.getfolder("C:\Lists")
'Schleife über alle Dateien im Ordner
With Application
.ScreenUpdating = False
For Each varDatei In Ordner.Files
If LCase(varDatei) Like "*.xlsm" Then
'Dateiname ausfiltern
DateiName = LCase(Right$(varDatei, Len(varDatei) - InStrRev(varDatei, "\")))
.StatusBar = "Lese Datei: " & DateiName
tempStrDatei = "'" & Replace(varDatei, DateiName, "[" & DateiName & "]1_Bau+Planung(Detail)'! _
")
If IsNumeric(Replace(DateiName, ".xlsm", "")) Then
'Name der Datei schreiben ohne Extention
Cells(i, "A") = Replace(DateiName, ".xlsm", "") 'Dateiname *******************
'String Formel erstellen, Achtung hier ist der Tabellenname zu beachten, hier Tabelle1
DateiName = tempStrDatei & Range("U4").Address(ReferenceStyle:=xlR1C1)
'schreibe Wert in Zelle
Cells(i, "D") = ExecuteExcel4Macro(DateiName)
'Zähler hochzählen für nächste Zeile
'Schleife Teilergebnisse
For a = 1 To Bereich.Cells.Count
'String SUMMENPRODUKT Einzelwerte*********************
tempName = _
"=SUMPRODUCT((" & tempStrDatei & _
Range("E7:E65000").Address(, , xlR1C1) & "=" & Bereich(a).Address(, , _
xlR1C1) & _
")*(" & tempStrDatei & Range("U7:U65000").Address(, , xlR1C1) & "))"
'Teilergebnis in Zelle schreiben als Formel*********************
Bereich(a).Offset(lngCol, 0) = [tempName]
Bereich(a).Offset(lngCol, 0).Value = Bereich(a).Offset(lngCol, 0).Value
Next a
lngCol = lngCol + 1
i = i + 1
End If 'Nummeric
End If
Next varDatei
.StatusBar = False
.ScreenUpdating = True
End With 'Application
ActiveSheet.Cells(2, 4).Value = Now
ActiveSheet.Cells(3, 4).Value = Application.UserName
MsgBox "Collation successfully", vbInformation, "Note for " & Application.UserName & ":"
End Sub