Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Excel 2007 Wie kann ich Verknüpfungen mittels VBA an bestimmte Stellen über mehrere Netzlaufwerke anlegen und verteilen?

Mitglied: cyberdevil0815

cyberdevil0815 (Level 1) - Jetzt verbinden

25.10.2011, aktualisiert 18.10.2012, 7531 Aufrufe, 7 Kommentare

Hallo zusammen,

ich möchte gerne mittels eines Excel Sheets und intergrierten VBA Skript eine Ordnerstruktur erstellen, welche auf 2 Netzlaufwerken abgelegt wird. Dies funktioniert im wesentlichen auch, nur kommt nun noch eine Raffinesse hinzu, welche ich nicht weiss wie ich diese Lösen könnte.

Laufwerk G:
Ordnerstruktur, wird mittels Excel Sheet und hinterlegten VBA Skript geschrieben und angelegt:


Laufwerk I:
Ordnerstruktur, wird mittels Excel Sheet und hinterlegten VBA Skript geschrieben und angelegt, hierbei handelt es im Wesentlichen um das selbe Prozedere NUR das hier NUR ein Ordner Namens Mechnik abgelegt wird.
Kundenname und Projektbezeichnung bleiben jedoch identisch.


Was soll nun gelöst werden?
Laufwerk G (eigenständiger Server) agiert, als reine Datenablage (Fileserver), Laufwerk I ist auch ein eigenständiger Server, nur findet hier noch ein 3 D Rendering Job für CAD Modelle statt, welcher viel Leistung und Performance in Anspruch nimmt. Dies zur Definition, wieso zwei Laufwerke verwendet werden sollen.

Nun möchte ich gerne das eine Verknüpfung angelegt wird.
Beispiel: Kunden Ordner X mit Projekt Y soll angelegt werden, mittels ausführen des Skriptes, wird auf Laufwerk G und I die Ordnerstruktur inkl. Dateien und Unterordner angelegt.
Der einzelne Ordner Mechanik auf I soll aber auch auf G sichtbar sein, also hätte ich gern eine Verknüpfung.
Ordner auf I, Verknüpfung kopieren auf G (im selben Kundenordner und Kundenprojekt).
So fit in Sachen VB schreiben/programmieren bin ich nun auch nicht, und ich weiss ehrlich gesagt, nicht so ganz wie ich das machen soll.
Jemand eine Idee?


322f98ad51cf329c4647909ae3283fd4 - Klicke auf das Bild, um es zu vergrößern

6974d39b808d680c51c12eedbcc5c473 - Klicke auf das Bild, um es zu vergrößern

01.
Sub Main()
02.

03.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 2
04.
Dim strData1 As String
05.
Dim strData2 As String
06.
Dim strData3 As String
07.
Dim strData4 As String
08.
Dim objWord As Object
09.

10.

11.
Pfad = "G:\Projekte\"
12.
Pfad1 = "I:\Projekte\"
13.

14.
If IsError(Sheets("Tabelle1").Cells(6, "E")) Then
15.
    MsgBox "Die Navisionlizenz lässt keine weiteren Anwender zu." & vbCrLf & _
16.
     "" & vbCrLf & _
17.
     "Warten Sie, bis ein anderer Anwender das Programm verlassen hat.", 48 + 0, _
18.
     "Projekt konnte nicht angelegt werden!"
19.
     Unload UserForm1
20.
     GoTo Abbruch2
21.
End If
22.

23.
A = Sheets("Tabelle1").Cells(6, "E")    'Verk. An Name
24.
Be = Sheets("Tabelle1").Cells(8, "E")   'Anlagennummer
25.
C = Sheets("Tabelle1").Cells(10, "E")   'Kom. Beschreibung
26.
D = Sheets("Tabelle1").Cells(12, "E")   'Nr. (Auftragsnummer)
27.

28.

29.
'*******************************************************************
30.
'*** Für die Ordnerstruktur ungültige Zeichen werden umgewandelt ***
31.
'*******************************************************************
32.

33.
C = Replace(C, "/", "_")
34.
C = Replace(C, "\", "_")
35.
C = Replace(C, ":", ";")
36.
C = Replace(C, "*", "+")
37.
C = Replace(C, "<", " ")
38.
C = Replace(C, ">", " ")
39.
C = Replace(C, "|", "_")
40.
C = Replace(C, "?", " ")
41.
C = Replace(C, "Chr(34)", "Chr(39)")
42.

43.
A = Replace(A, "/", "_")
44.
A = Replace(A, "\", "_")
45.
A = Replace(A, ":", ";")
46.
A = Replace(A, "*", "+")
47.
A = Replace(A, "<", " ")
48.
A = Replace(A, ">", " ")
49.
A = Replace(A, "|", "_")
50.
A = Replace(A, "?", " ")
51.
A = Replace(A, "Chr(34)", "Chr(39)")
52.

53.

54.
'*******************************************************************
55.
'*** Die aus Navision übernommenen Daten werden konntrolliert ******
56.
'*******************************************************************
57.

58.

59.
'Hat die Auftragsnummer das richtige Format?
60.
If IsNumeric(D) = False Then
61.
    MsgBox "Die Auftragsnummer darf nur aus Zahlen bestehen!", 48 + 0, "Ungültige Eingabe!"
62.
    Unload UserForm1
63.
    GoTo Abbruch
64.
End If
65.

66.
If Len(D) <> 8 Then
67.
    MsgBox "Die Auftragsnummer muss aus genau 8 Zahlen bestehen! Es sind aber " & Len(D), 48 + 0, "Ungültige Eingabe!"
68.
    Unload UserForm1
69.
    GoTo Abbruch
70.
End If
71.

72.
'Ist die Auftragsnummer vergeben?
73.
If D = "" Then
74.
    MsgBox "Es wurde kein Projekt gefunden!" & vbCrLf & _
75.
     "Dies kann folgende Ursachen haben:" & vbCrLf & _
76.
     "" & vbCrLf & _
77.
     "1. Die Auftragsnummer wurde falsch eingegeben." & vbCrLf & _
78.
     "2. Es wurde ein falscher Mandant ausgewählt.", 48 + 0, "Es wurde kein Projekt gefunden!"
79.
     Unload UserForm1
80.
     GoTo Abbruch
81.
End If
82.

83.
'Ist die Anlagennummer vergeben?
84.
If Be = "" Then
85.
    MsgBox "Es wurde in Navision keine Anlagennummer angegeben." & vbCrLf & _
86.
     "" & vbCrLf & _
87.
     "Bitte tragen sie diese zuerst nach, bevor sie das Projekt anlegen.", 48 + 0, _
88.
     "Keine Anlagennummer vergeben!"
89.
     Unload UserForm1
90.
     GoTo Ende
91.
End If
92.

93.
'Ist die Kom. Beschreibung vergeben?
94.
If C = "" Then
95.
    MsgBox "Es wurde in Navision keine Beschreibung angegeben." & vbCrLf & _
96.
     "" & vbCrLf & _
97.
     "Bitte tragen sie diese zuerst nach, bevor sie das Projekt anlegen.", 48 + 0, _
98.
     "Keine Beschreibung vorhanden!"
99.
     Unload UserForm1
100.
     GoTo Ende
101.
End If
102.

103.
'Ist die Anlagennummer vergeben?
104.
If A = "" Then
105.
    MsgBox "In Navision wurde das Feld 'Verk. an Name' ausgefüllt." & vbCrLf & _
106.
     "" & vbCrLf & _
107.
     "Bitte füllen sie dieses zuerst aus, bevor sie das Projekt anlegen.", _
108.
     48 + 0, "Keine Kundenname vorhanden!"
109.
     Unload UserForm1
110.
     GoTo Ende
111.
End If
112.

113.
'Anlagennummer ohne Punkt
114.
B = Right$(Be, 6)
115.

116.
'Wurde ein Ordnertyp ausgewählt?
117.
If Sheets("Tabelle1").Cells(3, "F") = 1 Then
118.
    MsgBox "Es wurde kein Ordnertyp ausgewählt", 48 + 0, "Achtung!"
119.
    Sheets("Tabelle1").Cells(3, "F") = ""
120.
    Unload UserForm1
121.
    GoTo Abbruch
122.
End If
123.

124.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
125.

126.
'*******************************************************************
127.
'*** Anlegen der Ordnerstruktur in Windows *************************
128.
'*******************************************************************
129.

130.
'Erstellen des Kundenordners auf LW I
131.
Name = Pfad1 & A
132.
If Dir(Name & "\", vbDirectory) = "" Then MkDir Name
133.

134.
'Erstellen des Unterordners mit Anlagennummer_Beschreibung
135.
ANR = Pfad1 & A & "\" & B & "_" & C
136.
If Dir(ANR & "\", vbDirectory) = "" And Dir(Name & "\" & B & "*", vbDirectory) = "" Then
137.
    MkDir ANR
138.
End If
139.

140.
'Erstellen der Unterordnerstruktur
141.
Unterordner = Pfad1 & A & "\" & B & "_" & C & "\"
142.

143.
OS10 = Unterordner & "Mechanik"
144.
MkDir OS10
145.

146.

147.

148.

149.
'Erstellen des Kundenordners auf LW G
150.
Name = Pfad & A
151.
If Dir(Name & "\", vbDirectory) = "" Then MkDir Name
152.

153.
'Erstellen des Unterordners mit Anlagennummer_Beschreibung
154.
ANR = Pfad & A & "\" & B & "_" & C
155.
If Dir(ANR & "\", vbDirectory) = "" And Dir(Name & "\" & B & "*", vbDirectory) = "" Then
156.
    MkDir ANR
157.
Else:
158.
    Ord = Name & "\" & Dir(Name & "\" & B & "*", vbDirectory)
159.
    ASV = Ord & "\" & "Schriftverkehr" & "\" & D & "_" & C
160.
    If Dir(ASV, vbDirectory) = "" Then
161.
        MkDir ASV
162.
        MkDir Ord & "\" & "\" & "Doku" & "\" & "Deutsch" & "\" & "Funktionspläne" & "\" & D & "_" & C & "\"
163.
        MkDir Ord & "\" & "\" & "Doku" & "\" & "Deutsch" & "\" & "Datenblätter" & "\" & D & "_" & C & "\"
164.
        UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 7
165.
        Unload UserForm1
166.
        GoTo Ende
167.
    
168.
    Else: MsgBox "Projekt bereits vorhanden"
169.
          Unload UserForm1
170.
          GoTo Abbruch
171.
    End If
172.
End If
173.

174.
'Erstellen der Unterordnerstruktur
175.
Unterordner = Pfad & A & "\" & B & "_" & C & "\"
176.

177.
OS1 = Unterordner & "Medien"
178.
MkDir OS1
179.
MkDir OS1 & "\" & "Videos"
180.
MkDir OS1 & "\" & "Fotos"
181.

182.
OS2 = Unterordner & "Berechnung"
183.
MkDir OS2
184.

185.
OS3 = Unterordner & "Doku"
186.
MkDir OS3
187.
MkDir OS3 & "\" & "Deutsch"
188.
MkDir OS3 & "\" & "Deutsch" & "\" & "Bedienungsanleitung"
189.
MkDir OS3 & "\" & "Deutsch" & "\" & "Funktionspläne"
190.
MkDir OS3 & "\" & "Deutsch" & "\" & "Funktionspläne" & "\" & D & "_" & C
191.
MkDir OS3 & "\" & "Deutsch" & "\" & "Datenblätter"
192.
MkDir OS3 & "\" & "Deutsch" & "\" & "Datenblätter" & "\" & D & "_" & C
193.
MkDir OS3 & "\" & "Englisch"
194.

195.
OS4 = Unterordner & "Durchlaufplan"
196.
MkDir OS4
197.

198.
OS5 = Unterordner & "Elektro"
199.
MkDir OS5
200.
MkDir OS5 & "\" & "Antriebe"
201.
MkDir OS5 & "\" & "Bustest"
202.
MkDir OS5 & "\" & "Display"
203.
MkDir OS5 & "\" & "E-Pläne"
204.
MkDir OS5 & "\" & "Sicherheitstechnik"
205.
MkDir OS5 & "\" & "Technische_Infos"
206.
MkDir OS5 & "\" & "Zubehör_Parameter"
207.
MkDir OS5 & "\" & "Programm"
208.
MkDir OS5 & "\" & "Programm" & "\" & "_Vorbereitet"
209.
MkDir OS5 & "\" & "Programm" & "\" & "_Vorlage"
210.

211.
OS6 = Unterordner & "LLV"
212.
MkDir OS6
213.

214.
OS7 = Unterordner & "Schriftverkehr"
215.
MkDir OS7
216.
MkDir OS7 & "\" & D & "_" & C
217.
MkDir OS7 & "\" & D & "_" & C & "\" & "Intern"
218.
MkDir OS7 & "\" & D & "_" & C & "\" & "Kunde"
219.
MkDir OS7 & "\" & D & "_" & C & "\" & "Zulieferer"
220.

221.
OS8 = Unterordner & "Kalkulation"
222.
MkDir OS8
223.

224.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
225.

226.

227.

228.
'*******************************************************************
229.
'*** Exceldokumente für Ordner Kalkulation kopieren*****************
230.
'*******************************************************************
231.

232.
'Excelsheet mitlaufende Kalkulation.xlsx speichern
233.

234.
Dim objExcel As Object
235.
Set objExcel = CreateObject("Excel.Application")
236.

237.

238.
objExcel.Application.Workbooks.Open "G:\Vordrucke\Projekte\Kalkulation\mitlaufende_Kalkulation.xlsx"
239.

240.
 With objExcel.ActiveWorkbook
241.
        .SaveAs Filename:=Unterordner & "Kalkulation\mitlaufende_Kalkulation" & "_" & D & ".xlsx"
242.
        .Close
243.
    End With
244.

245.

246.
Set objExcel = Nothing
247.

248.

249.
'Daten aus Exceldatei einlesen
250.
strData1 = A
251.
strData2 = B
252.
strData3 = C
253.
strData4 = D
254.

255.
'Excelsheet Nachkalkulation_geschlossen.xlsx speichern
256.

257.
Set objExcel = CreateObject("Excel.Application")
258.

259.

260.
objExcel.Application.Workbooks.Open "G:\Vordrucke\Projekte\Kalkulation\Nachkalkulation_geschlossen.xlsx"
261.

262.
 With objExcel.ActiveWorkbook
263.
        .SaveAs Filename:=Unterordner & "Kalkulation\Nachkalkulation_geschlossen" & "_" & D & ".xlsx"
264.
        .Close
265.
    End With
266.

267.

268.
Set objExcel = Nothing
269.

270.

271.
'Daten aus Exceldatei einlesen
272.
strData1 = A
273.
strData2 = B
274.
strData3 = C
275.
strData4 = D
276.

277.

278.
'*******************************************************************
279.
'*** Die Worddokumente werden bearbeitet****************************
280.
'*******************************************************************
281.

282.

283.
'Kopieren des Inhaltsverzeichnisses
284.
FileCopy "G:\Vordrucke\VD_Inhaltsverzeichnis Projektordner.doc", Unterordner & "Inhaltsverzeichnis.doc"
285.

286.
'Daten in Projektstand.xls eintragen
287.

288.
Set objExcel = CreateObject("Excel.Application")
289.

290.

291.
objExcel.Application.Workbooks.Open "G:\Vordrucke\Projektstand.xls"
292.
objExcel.Application.Sheets("Tabelle1").Select
293.

294.
 With objExcel.ActiveWorkbook
295.
        .Sheets("Tabelle1").Cells(1, "B") = A
296.
        .Sheets("Tabelle1").Cells(5, "B") = D
297.
        .Sheets("Tabelle1").Cells(6, "B") = B
298.
        .Sheets("Tabelle1").Cells(7, "B") = C
299.
        .SaveAs Filename:=Unterordner & "Projektstand" & "_" & D & ".xlsx"
300.
        .Close
301.
    End With
302.

303.

304.
Set objExcel = Nothing
305.

306.

307.
'Daten aus Exceldatei einlesen
308.
strData1 = A
309.
strData2 = B
310.
strData3 = C
311.
strData4 = D
312.

313.

314.
'*** Daten in "Vordruck für Ordnerrücken.doc" einfügen ***
315.
If Sheets("Tabelle1").Cells(2, "F") = 1 Then
316.
    Set objWord = CreateObject("Word.Application")
317.
    
318.
   '*** Hier wird der Pfad der Wordvorlage angegeben ***
319.
    objWord.documents.Open "G:\Vordrucke\VD_Vordruck für Ordnerrücken_v1.doc"
320.
    
321.
    'Text in die Textmarken einfügen
322.
    With objWord
323.
        .ActiveDocument.Bookmarks("Firma").Range.Text = strData1
324.
        .ActiveDocument.Bookmarks("Beschreibung").Range.Text = strData3
325.
        .ActiveDocument.Bookmarks("Anlagennummer").Range.Text = strData2
326.
    End With
327.
    
328.
    'Dokument speichern unter
329.
    objWord.ActiveDocument.SaveAs Unterordner & "Vordruck für Ordnerrücken.doc"
330.

331.
    'word beenden
332.
    objWord.Quit
333.
    
334.
    'objekt löschen
335.
    Set objWord = Nothing
336.

337.
End If
338.

339.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
340.

341.
If Sheets("Tabelle1").Cells(1, "F") = 1 Then
342.
    Set objWord = CreateObject("Word.Application")
343.
    
344.

345.
    '*** Hier wird der Pfad der Wordvorlage angegeben ***
346.
    objWord.documents.Open "G:\Vordrucke\VD_Vordruck für Ordnerrücken_schmal_v1.doc"
347.
    
348.
    With objWord
349.
        .ActiveDocument.Bookmarks("Firma").Range.Text = strData1
350.
        .ActiveDocument.Bookmarks("Beschreibung").Range.Text = strData3
351.
        .ActiveDocument.Bookmarks("Anlagennummer").Range.Text = strData2
352.
    End With
353.
    
354.
'Dokument speichern unter
355.
objWord.ActiveDocument.SaveAs Unterordner & "Vordruck für Ordnerrücken_schmal.doc"
356.

357.
'Word beenden
358.
objWord.Quit
359.
    
360.
'objekt löschen
361.
Set objWord = Nothing
362.
End If
363.

364.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 2
365.
    
366.
'Daten in "VD_Änderungen während des laufenden Projektes_v1.doc" einfügen
367.
Set objWord = CreateObject("Word.Application")
368.

369.

370.

371.
'*** Hier wird der Pfad der Wordvorlage angegeben ***
372.
objWord.documents.Open "G:\Vordrucke\VD_Änderungen während des laufenden Projektes_v1.doc"
373.
    
374.
With objWord
375.
    
376.
    .ActiveDocument.Bookmarks("Firma").Range.Text = strData1
377.
    .ActiveDocument.Bookmarks("Beschreibung").Range.Text = strData3
378.
    .ActiveDocument.Bookmarks("Anlagennummer").Range.Text = strData2
379.
    .ActiveDocument.Bookmarks("Kommissionsnummer").Range.Text = strData4
380.
    End With
381.
    
382.

383.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 2
384.

385.
'Dokument speichern unter
386.
objWord.ActiveDocument.SaveAs Unterordner & "Änderungen während des laufenden Projektes"
387.

388.
'word beenden
389.
objWord.Quit
390.

391.
'objekt löschen
392.
Set objWord = Nothing
393.

394.
UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
395.

396.
Unload UserForm1
397.

398.
Ende:
399.
MsgBox "Projekt wurde erfolgreich erstellt"
400.

401.
Abbruch2:
402.
Application.DisplayAlerts = False
403.
Workbooks("Projektordner.xls").Close SaveChanges:=False
404.

405.
Abbruch:
406.
Unload UserForm1
407.
Unload Projektdokumentation
408.
Application.WindowState = xlMaximized
409.

410.
End Sub
Mitglied: bastla
25.10.2011, aktualisiert 18.10.2012
Hallo cyberdevil0815!

Falls Du mit "Verknüpfung" wirklich "Verknüpfung" (Dateityp ".lnk") meinst, findest Du etwa im Beitrag Anlegen eines Shortcuts auf dem Desktop ein Beispiel ...

Grüße
bastla
Bitte warten ..
Mitglied: cyberdevil0815
25.10.2011 um 15:02 Uhr
Hey bastla,

vielen Dank für den Tip, aber wirklich schlau bin ich nicht daraus geworden.

Ich habe das Posting von mir, um den VBA Quelltext erweitert. Vielleicht kann mir damit ja noch jemand eher auf die Sprünge helfen.
Bitte warten ..
Mitglied: bastla
25.10.2011 um 23:09 Uhr
Hallo cyberdevil0815!

Im einfachsten Fall fügst Du an passender Stelle ab Zeile 176 etwa folgendes ein:
01.
Set oShellLink = WScript.CreateObject("WScript.Shell").CreateShortcut(Unterordner & "\Mechanik.lnk") 'Link in "Unterordner" erstellen
02.
oShellLink.TargetPath = OS10 'Verlinkter Ordner
03.
oShellLink.WorkingDirectory = OS10 'Verlinkter Ordner
04.
oShellLink.Save 
Grüße
bastla
Bitte warten ..
Mitglied: cyberdevil0815
27.10.2011 um 07:40 Uhr
Guten morgen zusammen,

ich bin schon mal soweit, dass ich zumindestens eine Verknüpfung generiert bekomme, welche auf das korrekte Verzeichnis verweist.
ABER:
Die Verknüpfung befindet sich am falschen Ort, hier habe ich garantiert einen kleinen Denkfehler, aber ich seh den Wald vor lauter Bäumen nicht.

Das Resultat sieht derzeit so aus:

4ffb282a781f35899293dddb83e3e760 - Klicke auf das Bild, um es zu vergrößern

Die Verknüpfung liegt zwar auf dem korrekten Laufwerk, aber im falschen Ordner. Da die Ordnerstruktur auf beiden Laufwerken gleich ist (ausnahme Bilden hier die Unterordner, sonst bräuchte ich die Verknüpfung nicht).

Mein aktueller Code
01.
   Set WSHShell = CreateObject("WScript.Shell")
02.
        Set ProjektShortcut = WSHShell.CreateShortcut("Mechanik.lnk")
03.
        ProjektShortcut.TargetPath = OS10  'Mechanik
04.
        ProjektShortcut.Save
05.
        Set ProjektShortcut = Nothing
06.
        Set WSHShell = Nothing
Bitte warten ..
Mitglied: bastla
27.10.2011 um 10:58 Uhr
Hallo cyberdevil0815!

Da ja Du genau wissen musst, wo die Verknüpfung liegen soll (in einem Unterordner des in der Variablen "Unterordner" festgelegten Pafdes?), kann ich nur nochmals auf die Zeile 2 hinweisen - dort wird der Speicherort (als kompletter Pfad) festgelegt ...

Grüße
bastla
Bitte warten ..
Mitglied: cyberdevil0815
27.10.2011 um 14:20 Uhr
So nun gelöst, Code an Zeilennummer 226 eingefügt:

01.
Set WSHShell = CreateObject("WScript.Shell")
02.
        'Hier kommt der Verweis nach G hin
03.
        Set ProjektShortcut = WSHShell.CreateShortcut(ANR & "\" & "Mechanik.lnk")
04.
        'Wohin soll der Link verweisen
05.
        ProjektShortcut.TargetPath = OS10  'Mechanik
06.
        ProjektShortcut.Save
07.
        Set ProjektShortcut = Nothing
08.
        Set WSHShell = Nothing
Skript funktioniert nun wunderbar und wie gewünscht. Vielen Dank @bastla für den richtigen Schubser
Bitte warten ..
Mitglied: bastla
27.10.2011 um 15:13 Uhr
Hallo cyberdevil0815!

Freut mich ...

Grüße
bastla

P.S.: Magst Du noch einen Haken an den Thread machen?
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Excel VBA vbyesno
gelöst Frage von Florian86Microsoft Office2 Kommentare

Hallo, ich habe folgenden Code Sub AbgerundetesRechteck1_Klicken() Dim wksOrig As Worksheet Dim wksStore As Worksheet Dim lngLastRow As Long ...

VB for Applications
Excel VBA Code
gelöst Frage von specialuserVB for Applications2 Kommentare

Hallo zusammen, Hab hier einen Button in einer Excel mit Makros erstellt. Der Button hat die Funktion aus der ...

Microsoft Office
Excel VBA - PDF
Frage von SabineTMicrosoft Office3 Kommentare

Hallo Zusammen, ich habe ein pdf, über welches ich bereits die OCR Texterkennung laufen lassen habe. Jetzt möchte ich ...

VB for Applications
Excel VBA Programmierung
gelöst Frage von specialuserVB for Applications7 Kommentare

Hallo zusammen, ich suche auf diesem Weg Hilfe bei einer VBA Programmierung. Und zwar geht es darum 2 Dropdownlisten ...

Neue Wissensbeiträge
Router & Routing

Zyxel VMG 1312 B30A - Firmwareupdate nur im "privaten" Firefox Modus möglich

Tipp von the-buccaneer vor 1 StundeRouter & Routing

Hatte hier ein Zyxel 1312 das ums verrecken kein Firmwareupdate durchführen wollte. Datei ist auswählbar, dann kommt der Fortschrittskreisel ...

Windows 7

Windows 7 u. Server 2008 (R2) SHA-2-Update kommt am 12. März 2019

Information von kgborn vor 1 TagWindows 75 Kommentare

Kleine Info für die Admins der oben genannten Maschinen. Ab Juli 2019 werden Updates von Microsoft nur noch mit ...

Firewall
PfSense 2.5.0 benötigt doch kein AES-NI
Information von ChriBo vor 3 TagenFirewall2 Kommentare

Hallo, Wie sich einige hier erinnern werden hat Jim Thompson in diesem Aritkel beschrieben, daß ab Version 2.5.0 ein ...

Internet
Copyright-Reform: Upload-Filter
Information von Frank vor 4 TagenInternet1 Kommentar

Hallo, viele Menschen reden aktuell von Upload-Filtern. Sie reden darüber, als wären es eine Selbstverständlichkeit, das Upload-Filter den Seitenbetreibern ...

Heiß diskutierte Inhalte
Hardware
IT-Werkzeugkoffer bis 50,- EUR
gelöst Frage von departure69Hardware44 Kommentare

Hallo. Ich bin als IT-Systembetreuer einer Gemeinde zusätzlich auch der IT-Systembetreuer einer Grund- und Hauptschule. Dort muß ich jedoch ...

Netzwerke
Verteilung von Programmdaten außerhalb des internen Netzwerkes
Frage von mertaufmbergNetzwerke27 Kommentare

Guten Morgen liebe Administratoren, ich versuche zurzeit eine möglichst sichere und einfache Lösung zu suchen, um ein Programmverzeichnis über ...

Netzwerkmanagement
Richtfunknetzwerk mit vielen Hops stabiler gestalten
Frage von turti83Netzwerkmanagement22 Kommentare

Hallo, in meinem Dorf habe ich vor ca. einem Jahr ein Backbone aufgebaut um die Nachbarschaft mit Internet zu ...

Hyper-V
Intel MSC Raid 5 Rebuild
Frage von DannysHyper-V19 Kommentare

Hallo Community, Ich habe einen Modul Server von Intel in Betrieb. Dort ist eine Festplatte aus dem Raid 5 ...