Betrifft: Verknüpfung per VBA löschen & Sicherung
von: Rupert Föderler
Geschrieben am: 03.02.2010 18:15:03
Hallo Forum,
Ich müsste bei ein paar Datein, welche ich mit Application.filsearch öffne, die Links löschen und die Datei ohne links unter dem selben dateinamen & _values speichern.
hier mal meine Vorbereitung
Sub Öffnen_Details() Dim iCounter As Integer, XXX() As Workbook, AllLinks As Variant, i As Long AllLinks = ActiveWorkbook.LinkSources(xlExcelLinks) With Application.FileSearch .LookIn = ThisWorkbook.Path & "\XXX" .SearchSubFolders = False .Execute msoSortByFileType .FileType = msoFileTypeExcelWorkbooks ReDim XXX(1 To .FoundFiles.Count) For iCounter = 1 To .FoundFiles.Count For i = LBound(AllLinks) To UBound(AllLinks) Workbooks.Open Filename:= _ .FoundFiles(iCounter) _ , UpdateLinks:=0 Application.DisplayAlerts = False ActiveWorkbook.Save Sheets("LOCAL").Activate Debug.Print "Breaking link to file " & AllLinks(i) ActiveWorkbook.BreakLink Name:=AllLinks(i), _ Type:=xlExcelLinks Sheets("LOCAL").Activate Application.DisplayAlerts = True Application.DisplayAlerts = False Dim StrValue As String StrValue = "_VALUE" ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\values\" & Left(ActiveWorkbook. _ _Name, Len(ActiveWorkbook.Name) - 4) & StrValue Application.DisplayAlerts = True ActiveWorkbook.Close Next i Next iCounter End With end subIch bekomme aber einen laufzeitfehler 13 - Typen unveträglich bei der zeile
Sub testIt() Dim AllLinks As Variant, i As Long AllLinks = ActiveWorkbook.LinkSources(xlExcelLinks) If IsEmpty(AllLinks) Then GoTo XIT For i = LBound(AllLinks) To UBound(AllLinks) Debug.Print "Breaking link to file " & AllLinks(i) ActiveWorkbook.BreakLink Name:=AllLinks(i), _ Type:=xlExcelLinks Next i XIT: End Subfunktioniert dieser, wo liegt mein denkfehler, ich kann doch 2 For definieren, oder liege ich hier falsch?
Betrifft: AW: Verknüpfung per VBA löschen & Sicherung
von: Uduuh
Geschrieben am: 03.02.2010 18:57:03
Hallo,
du definierst AllLinks für das WB in dem das Makro steht, nicht für das neu geöffnete.
Die Schleifen sind falsch geschachtelt
Was soll XXX ?
Teste mal
Sub Öffnen_Details() Dim iCounter As Integer, AllLinks As Variant, i As Long Const StrValue As String = "_VALUE" With Application.FileSearch .LookIn = ThisWorkbook.Path & "\XXX" .SearchSubFolders = False .Execute msoSortByFileType .FileType = msoFileTypeExcelWorkbooks For iCounter = 1 To .FoundFiles.Count Workbooks.Open Filename:= _ .FoundFiles(iCounter) _ , UpdateLinks:=0 AllLinks = ActiveWorkbook.LinkSources(xlExcelLinks) For i = LBound(AllLinks) To UBound(AllLinks) Debug.Print "Breaking link to file " & AllLinks(i) ActiveWorkbook.BreakLink Name:=AllLinks(i), _ Type:=xlExcelLinks Application.DisplayAlerts = False ActiveWorkbook.SaveAs _ Filename:=ActiveWorkbook.Path _ & "\values\" _ & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) _ & StrValue Application.DisplayAlerts = True ActiveWorkbook.Close False Next i Next iCounter End With End SubGruß aus’m Pott
Betrifft: AW: Verknüpfung per VBA löschen & Sicherung
von: Rupert Föderler
Geschrieben am: 04.02.2010 08:19:17
Hallo Udo,
Vielen dank, das funktioniert wunderbar. Das XXX ist einfach nur der Unterordner, bzw der dateiname.
Hat jemand noch eine idee wie ich das für Excel 2007 lösen könnte, da die funktion Application.filesearch ja deaktiviert wurde von seitens Microsoft.
lg
rupert