Hi,
ein Bekannter hat mich um seine Hilfe gebeten.
Er hat ein VBA Script welches Ihm bei seinen Word Dokumenten hilft.
Nachdem er auf die aktuelle Word Version upgedatet hat bekommt er folgende Fehlermeldung:
Laufzeitfehler 5: Ungültiger Prozeduraufruf oder ungültiges Argument
Da ich mich in VBA nicht auskenne würde ich mich um eine Unterstützung freuen.
Hier das Script:
ein Bekannter hat mich um seine Hilfe gebeten.
Er hat ein VBA Script welches Ihm bei seinen Word Dokumenten hilft.
Nachdem er auf die aktuelle Word Version upgedatet hat bekommt er folgende Fehlermeldung:
Laufzeitfehler 5: Ungültiger Prozeduraufruf oder ungültiges Argument
Da ich mich in VBA nicht auskenne würde ich mich um eine Unterstützung freuen.
Hier das Script:
Quellcode
- Private Sub Command1_Click()
- StartScreen.Show
- Unload WADatenbank
- End Sub
- Private Sub Command2_Click()
- Open BasisVerz & "\WA\" & File1.FileName For Input As #1
- Open BasisVerz & "\WA\temp.tmp" For Output As #2
- Input #1, tmp1
- Write #2, Text1.Text
- Do While Not EOF(1)
- Input #1, temp2
- Write #2, temp2
- Loop
- Close #1
- Close #2
- Kill (BasisVerz & "\WA\" & File1.FileName)
- AlterName = BasisVerz & "\WA\temp.tmp": Neuername = BasisVerz & "\WA\" & File1.FileName
- Name AlterName As Neuername
- End Sub
- Private Sub Command3_Click()
- If List1.ListIndex <> -1 Then
- 'Set objWordComment = New Word.Application
- ''Set objWord = New Word.Document
- ' With objWordComment
- ' .Visible = False
- ' '.WindowState = 1 'wdWindowStateNormal
- ' '.Top = 0
- ' '.Left = 0
- ' '.Width = .PixelsToPoints(640)
- ' '.Height = .PixelsToPoints(480)
- ' '.StatusBar = "Word " & .Version & " (Build: " & .Build & ")"
- ' tems = Split(List1.List(List1.ListIndex), "-")
- ' tems2 = tems(2)
- ' tempver = Left(tems2, Len(tems2) - 4)
- ' .Documents.Open FileName:=BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex)
- ' ActiveDocument.BuiltInDocumentProperties(wdPropertyComments).Value = Text3.Text
- ' .Documents.Close
- ' .Application.Quit
- 'End With
- ''AppActivate objWord
- 'Set objWordComment = Nothing
- On Error Resume Next
- tems = Split(List1.List(List1.ListIndex), "-")
- tems2 = tems(2)
- tempver = Left(tems2, Len(tems2) - 4)
- Open BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex) & ".info" For Output As #2
- Write #2, Text3.Text
- Close #2
- End If
- End Sub
- Private Sub Command4_Click()
- If List1.ListIndex <> -1 Then
- erg = MsgBox("Wollen Sie die Datei " & List1.List(List1.ListIndex) & " wirklich löschen?", vbYesNo, "Sicherheitsabfrage")
- If erg = vbYes Then
- tems = Split(List1.List(List1.ListIndex), "-")
- tems2 = tems(2)
- tempver = Left(tems2, Len(tems2) - 4)
- Kill (BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex))
- Kill (BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex) & ".info")
- List1.RemoveItem (List1.ListIndex)
- Open BasisVerz & "\WA\" & File1.FileName For Input As #1
- Open BasisVerz & "\WA\temp.tmp" For Output As #2
- Input #1, tmp1
- Write #2, tmp1
- Do While List1.ListCount > 0
- List1.ListIndex = 0
- Write #2, List1.List(List1.ListIndex)
- List1.RemoveItem (List1.ListIndex)
- Loop
- Close #1
- Close #2
- Kill (BasisVerz & "\WA\" & File1.FileName)
- AlterName = BasisVerz & "\WA\temp.tmp": Neuername = BasisVerz & "\WA\" & File1.FileName
- Name AlterName As Neuername
- AktWA = File1.FileName
- If File1.FileName <> "" Then
- Text2.Text = Mid(File1.FileName, 3)
- On Error Resume Next
- Open BasisVerz & "\WA\" & File1.FileName For Input As #1
- Input #1, temp1
- Do While Not EOF(1)
- Input #1, temp2
- List1.AddItem temp2
- Loop
- Close #1
- Text1.Text = temp1
- End If
- End If
- End If
- End Sub
- Private Sub File1_Click()
- Text3.Text = ""
- List1.Clear
- List2.Clear
- AktWA = File1.FileName
- If File1.FileName <> "" Then
- Text2.Text = Mid(File1.FileName, 3)
- On Error Resume Next
- Open BasisVerz & "\WA\" & File1.FileName For Input As #1
- Input #1, temp1
- Do While Not EOF(1)
- Input #1, temp2
- List2.AddItem temp2
- Loop
- Close #1
- Text1.Text = temp1
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "An" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Ar" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Au" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Be" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Br" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Fa" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Li" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- For za = 0 To List2.ListCount - 1
- If Mid(List2.List(za), 18, 2) = "Re" Then
- List1.AddItem (List2.List(za))
- List2.RemoveItem (za)
- za = za - 1
- End If
- Next za
- If List1.ListCount > 0 Then List1.ListIndex = List1.ListCount - 1
- End If
- End Sub
- Private Sub Form_Load()
- Me.Left = MDIForm1.Width / 2 - Me.Width / 2 '- MDIForm1.Left
- Me.Top = MDIForm1.Height / 2 - Me.Height / 2 '- MDIForm1.Top
- If RunsLokal = True Then
- Command2.Enabled = False
- Command4.Enabled = False
- Frame5.Enabled = False
- End If
- File1.Path = BasisVerz & "\WA"
- End Sub
- Private Sub List1_Click()
- Text3.Text = ""
- 'If List1.ListIndex <> -1 Then
- 'Set objWordComment = New Word.Application
- ''Set objWord = New Word.Document
- ' With objWordComment
- ' .Visible = False
- ' '.WindowState = 1 'wdWindowStateNormal
- ' '.Top = 0
- ' '.Left = 0
- ' '.Width = .PixelsToPoints(640)
- ' '.Height = .PixelsToPoints(480)
- ' '.StatusBar = "Word " & .Version & " (Build: " & .Build & ")"
- ' tems = Split(List1.List(List1.ListIndex), "-")
- ' tems2 = tems(2)
- ' tempver = Left(tems2, Len(tems2) - 4)
- ' .Documents.Open FileName:=BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex)
- ' Text3.Text = .ActiveDocument.BuiltInDocumentProperties(wdPropertyComments).Value
- ' .Documents.Close
- ' .Application.Quit
- 'End With
- ''AppActivate objWord
- 'Set objWordComment = Nothing
- 'End If
- If List1.ListIndex <> -1 Then
- On Error GoTo nofile
- tems = Split(List1.List(List1.ListIndex), "-")
- tems2 = tems(2)
- tempver = Left(tems2, Len(tems2) - 4)
- Open BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex) & ".info" For Input As #2
- Input #2, datinfo
- Close #2
- Text3.Text = datinfo
- End If
- Exit Sub
- nofile:
- Text3.Text = ""
- End Sub
- Private Sub List1_DblClick()
- If List1.ListIndex <> -1 Then
- Set objWord = New Word.Application
- 'Set objWord = New Word.Document
- With objWord
- .Visible = True
- .WindowState = 1 'wdWindowStateNormal
- '.Top = 0
- '.Left = 0
- '.Width = .PixelsToPoints(640)
- '.Height = .PixelsToPoints(480)
- .StatusBar = "Word " & .Version & " (Build: " & .Build & ")"
- tems = Split(List1.List(List1.ListIndex), "-")
- tems2 = tems(2)
- tempver = Left(tems2, Len(tems2) - 4)
- .Documents.Open FileName:=BasisVerz & "\" & tempver & "\" & List1.List(List1.ListIndex)
- ' MsgBox .ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor).Value
- End With
- AppActivate objWord
- Set objWord = Nothing
- End If
- End Sub
- Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
- For za = 0 To File1.ListCount
- If File1.List(za) = "WA" & Format(Val(Text2.Text), "0000") Then
- File1.ListIndex = za
- Exit For
- Else
- File1.ListIndex = -1
- End If
- Next za
- End Sub