Fehler beim Zip entpacken
25.12.2006 13:14:36
Anja
ich hoffe ihr könnt mir weiterhelfen.
Ich möchte mit "Sub Link" die 4 Subs hintereinander ausführen, nur leider bleibt
das Makro an der Stelle 'Datei Öffnen' --> "Open File For Input As #1" im "Sub
Report_Bilder_Zoomen" immer stehen. Was mache ich falsch? Das Zip wird
auch nicht geöffnet und auch nicht gelöscht am Ende. Würde mich freuen wenn mal jemand meine Subs anschaut
und mir vielleicht einen Tip gibt, bin schon fast am verzweifeln ;-)
Hier noch kurz der Verlauf was passieren sollte:
Sub Neuer_Ordner: Neuer Ordner erstellen mit dem Namen der selektieren Zelle
Sub Entpacken: die Report.zip in dem Neuerstelleten Ordner entpacken,
Sub Report_Bilder_zoomen: dann in der entpackten Report.html die vorhandenen Bilder zoomen und speichern
Sub Hyperlink: einen Hyperlink 2 Spalten von der selektierten Zeile weiter einfügen.
Vielen Dank schon im Voraus.
Gruß Anja
Sub Link()
Neuer_Ordner
Entpacken
Report_Bilder_zoomen
Hyperlink
End Sub
________________________________________________________________
Sub Neuer_Ordner()
Dim sDir As String
Dim sDatei As String
sDir = "C:\Recipe_Doku\"
sDatei = ActiveCell
If Sheets(1).Range("B" & Selection.Row).Text = "" Then
MsgBox "no entry selected"
Exit Sub
End If
If sDir = "" Then Exit Sub
If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
SendKeys "{end}"
sDir = InputBox("Neuen Verzeichnisnamen eingeben:", , sDir + sDatei)
If sDir = "" Then Exit Sub
On Error GoTo ERRORHANDLER
MkDir sDir
Exit Sub
ERRORHANDLER:
MsgBox "Das Verzeichnis konnte nicht erstellt werden!"
End Sub
____________________________________________________________________
Sub Entpacken()
Dim strWin As String, strArchiv As String, strPfad As String, strFolder As String
strWin = "c:\program files\winzip\9_EL\WINZIP32.EXE -e"
strArchiv = "C:\Recipe_Doku\Report.zip"
strPfad = "C:\Recipe_Doku\"
strFolder = Selection
Shell strWin & strArchiv & strPfad + strFolder
Kill "C:\Recipe_Doku\Report.zip
End Sub
________________________________________________________________________
Sub Report_Bilder_zoomen()
Dim iCounter As Integer
'Dim File As String
sPfad = "C:\Recipe_Doku\"
sFolder = Selection
'sPfad = InputBox("Pfad")
ChDir (sPfad + sFolder)
File = "Report.html"
' Datei öffnen
Open File For Input As #1
' Zeileinweise die Spalten füllen
' Datei komplett einlesen
sBuffer = Input$(LOF(1), 1)
'Datei schließen
Close #1
'Debug.Print sBuffer
' Ersetzung vornehmen
sNeu = Replace(sBuffer, "WIDTH='120' HEIGHT='120'", "WIDTH='300' HEIGHT='300'", vbTextCompare)
Open File For Output As #2
Print #2, sNeu;
Close #2
Exit Sub
End Sub
__________________________________________________________________________
Sub Hyperlink()
Dim sDir As String
Dim sDatei As String
sDir = "C:\Recipe_Doku\"
sVerzeichnis = ActiveCell
sDatei = "Report.html"
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell(, 3), Address:=sDir & sVerzeichnis & "\" & sDatei, TextToDisplay:=sVerzeichnis
End Sub