AW: Laufzeitfehler 429 Objekterstellung ...
19.04.2020 14:33:30
Hans
Hallo zusammen,
alles klar dann ist hier der Code...
VG
Sub Freitextinfuegen()
Dim Nummer As String
Dim pre As String
Dim Unterordner As String
Dim Dokumente As String
Dim DokumenteSource As String
Dim Dokumentname As String
Dim Dokumentennamekomplett As String
Dim i As Variant
Dim x As Variant
Dim y As Variant
Dim Dokumentnamekomplett As String
Worksheets("Eingabefenster").Activate
Nummer = ("XXX-" & ActiveWorkbook.Sheets("Eingabefenster").Range("B4").Value)
Dokumentennamekomplett = ("XXX-" & ActiveWorkbook.Sheets("Eingabefenster").Range("B4").Value & " _
" & Name)
x = Sheets("Dokumentenhierarchie").Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To x
Worksheets("Dokumentenhierarchie").Activate
DokumenteSource = ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 3).Value
Dokumente = pre & "XXX-" & ActiveWorkbook.Sheets("Eingabefenster").Range("B4").Value & " " & _
Name & "\" & ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 2).Value & "\" & Nummer & "_" & Name & ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value
Unterordner = ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 2).Value
Dokumentname = ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value
If ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value = "Name2.xlsx" Or _
ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value = "_Name1.docm" Or _
_
ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value = "Name3" Then
y = InputBox("Wollen Sie einen Freitext zu Dokumentname als Endung hinzufügen?")
If y = "n" Then
End If
Else
FileCopy DokumenteSource, pre & Dokumentennamekomplett & "\" & ActiveWorkbook. _
Sheets("Dokumentenhierarchie").Cells(i, 2).Value & "\" & Nummer & "_" & Name & y & ActiveWorkbook.Sheets("Dokumentenhierarchie").Cells(i, 5).Value
End If
Next
End Sub