Link anstatt Zahl - Buchstaben | HERBERS Excel Forum

Sub Werteeinlesen(sWsName As String) Dim loLetzte As Long Dim Fullpfad As String Dim i As Long Dim pfad As String Dim lOrdnername As Long Dim sVorlagename As String Dim sArchivOrdner As String Dim Ziel As Range Dim sh As Worksheet pfad = ThisWorkbook.Path Set sh = Worksheets(sWsName) loLetzte = sh.Cells(Rows.Count, 1).End(xlUp).Row sVorlagename = "Vorlage.xlsm" sArchivOrdner = sh.Cells(2, "W").Value For i = 8 To loLetzte lOrdnername = sh.Cells(i, 1).Value Set Ziel = sh.Cells(i, 6) 'wo soll der wert das 2x hin If IsNumeric(lOrdnername) And IsDate(sh.Cells(i, 2).Value) Then Fullpfad = pfad & "\" & lOrdnername & "\" & sArchivOrdner & "\" & sVorlagename If Dir(Fullpfad) "" Then GetDataClosedWB pfad & "\" & lOrdnername & "\" & sArchivOrdner & "\", _ sVorlagename, _ "config", _ "h2:n2", _ Ziel End If End If Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Werteeinlesen(sWsName As String) Dim loLetzte As Long Dim Fullpfad As String Dim i As Long Dim pfad As String Dim sOrdnername As String Dim sVorlagename As String Dim sArchivOrdner As String Dim Ziel As Range Dim sh As Worksheet pfad = ThisWorkbook.Path Set sh = Worksheets(sWsName) loLetzte = sh.Cells(Rows.Count, 1).End(xlUp).Row sVorlagename = "Vorlage.xlsm" sArchivOrdner = sh.Cells(2, "W").Value For i = 8 To loLetzte sOrdnername = sh.Cells(i, 1).Text Set Ziel = sh.Cells(i, 6) 'wo soll der wert das 2x hin If IsDate(sh.Cells(i, 2).Value) Then Fullpfad = pfad & "\" & sOrdnername & "\" & sArchivOrdner & "\" & sVorlagename If Dir(Fullpfad) "" Then GetDataClosedWB pfad & "\" & sOrdnername & "\" & sArchivOrdner & "\", _ sVorlagename, _ "config", _ "h2:n2", _ Ziel End If End If Next i End Sub

Public Sub Werteeinlesen(sWsName As String) Const VORLAGENAME = "Vorlage.xlsm" Dim Fullpfad As String Dim i As Long Dim sOrdnername As String Dim sVorlagename As String Dim sArchivOrdner As String With Worksheets(sWsName) sArchivOrdner = .Cells(2, 23).Text For i = 8 To .Cells(.Rows.Count, 1).End(xlUp).Row If IsDate(.Cells(i, 2).Value) Then sOrdnername = .Cells(i, 1).Text Fullpfad = ThisWorkbook.Path & "\" & sOrdnername & "\" & sArchivOrdner & "\" If Dir$(Fullpfad & VORLAGENAME) vbNullString Then GetDataClosedWB _ Fullpfad, _ VORLAGENAME, _ "config", _ "H2:N2", _ .Cells(i, 6) End If End If Next End With End Sub

Hallo Marcus,
einige Zeichen sind als Teil eines Dateinamen nicht erlaubt. Diese kannst Du testen und melden:


Sub Werteeinlesen(sWsName As String)
Dim Pfad As String
Dim sArchivOrdner As String
Dim Z As Range
Const sVorlagename = "Vorlage.xlsm"
sArchivOrdner = Worksheets(sWsName).Range("W2").Value
For Each Z In Worksheets(sWsName).Range(Range("A8"), Cells(Rows.Count, "A").End(xlUp))
If IsNumeric(Z.Value) And IsDate(Z.Offset(,2).Value) Then
Pfad = ThisWorkbook.Pfad & "\" & Z.Value & "\" & sArchivOrdner & "\"
If Not IstDateiNameOk(Pfad) Then
Debug.Print "Problem mit: " & Pfad
ElseIf Dir(Pfad & sVorlagename)  "" Then
GetDataClosedWB Pfad, sVorlagename, "config", "h2:n2", Z.Offset(,6).Value
End If
End If
Next
End Sub
Private Function IstDateiNameOk(ByVal DateiTeilName As String) As Boolean
Dim C
For Each C In Split("? *  . , \ + : = / "" ; [ ] |")
If InStr(1, DateiTeilName, C) Then Exit Function
Next
IstDateiNameOk = True
End Function

Ich bevorzuge die Sparsamkeit bei Variablen. Aber es macht es nicht leichter zu debugen, da keine Sichtbarkeit in dem lokalen Fenster.
Zum Beispiel, wenn man eine Range-Variable (Z) als Schleifen-Variable, dann ist Worksheets(sWsName) nur zweimal verwendet. Es ist daher fraglich, ob eine Variable dafür notwendig ist.
Auch die Kombination Fullpfad nimmt in deiner Variante sVorlagename (unveränderbar, daher Const) dazu, was eine separate Stringbildung notwendig macht, um nur den Pfad zu prüfen. Wenn man den Pfad ohne sVorlagename bildet, kann man Pfad öfter wiederverwenden.
VG
Yal

Option Explicit Sub dateienablegen(rngTarget As Range) Dim Pfad As String Dim Vorlage As String Dim Ziel As Range Dim Fullpfad As String Dim sh As Worksheet Set sh = rngTarget.Parent Pfad = ThisWorkbook.Path ' 'make id ' If IsNumeric(rngTarget.Offset(-1, -1).Value) Then ' rngTarget.Offset(, -1).Value = rngTarget.Offset(-1, -1).Value + 1 ' End If Fullpfad = Pfad & "\" & sh.Cells(rngTarget.Row, 1).Value & "\" & sh.Range("w2") & "\" 'Hyperlink anlegen ActiveSheet.Hyperlinks.Add Anchor:=rngTarget.Offset(, -1), _ Address:=Fullpfad, _ ScreenTip:="Öffne " & Fullpfad, _ TextToDisplay:=Fullpfad Call einenUnterOrdner_erstellen64bit(Fullpfad) Set Ziel = rngTarget.Offset(, 4) 'wo soll der wert das erstemal hin If GetDataClosedWB(Pfad & "\", "Vorlage.xlsm", "config", "h2:n2", Ziel) Then MsgBox "Daten importiert" End If Vorlage = ActiveWorkbook.Path & "\Vorlage.xlsm" FileCopy Vorlage, Fullpfad & Dir(Vorlage) Set Ziel = rngTarget.Offset(, 2) End Sub

Beliebteste Forumthreads (12 Monate)

Link anstatt Zahl - Buchstaben

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread