Application.FileSearch

[Kramer]

Beste forumleden.

Ik heb een macro die gebruikt maakt van de functie Application.FileSearch. Deze werkt perfect WORD 2003 maar in WORD 2010 krijg ik een foutmelding. Wat ik op internet gevonden heb zit de fout in dat ik de functie Application.FileSearch gebruik. Maar ik kan nergens iets vinden om dit te omzeilen.

Sub opslaan()
Dim strDir As String
Dim strFileName As String
Dim FSO As New Scripting.FileSystemObject

strDir = Options.DefaultFilePath(wdDocumentsPath) 'Bestandslocatie documenten
strFileName = ActiveDocument.Name

    ActiveDocument.Save
    ChangeFileOpenDirectory "t:\cor\"

    With Application.FileSearch
        .LookIn = CurDir
        .FileName = strFileName
        If .Execute > 0 Then
            With Dialogs(wdDialogFileSaveAs)
                .Name = "t:\cor\" & strFileName
                .Show
            End With
        Else
            ActiveDocument.SaveAs strFileName
        End If
    End With

    ActiveDocument.Close

    ChangeFileOpenDirectory strDir

    With Application.FileSearch
        .LookIn = CurDir
        .FileName = strFileName
        If .Execute > 0 Then
            FSO.DeleteFile strFileName, True
        Else
        End If
    End With

    Dialogs(wdDialogFileOpen).Show

End Sub

 

[edmoor]

Dat is een bekende:
http://support.microsoft.com/kb/920229

 

[Kramer]

@edmoor

Deze had ik zelf ook gevonden maar ik snapte daar weinig aan. In die zin hoe ik mijn code moet aanpassen.

 

[edmoor]

Ok, dat kan. Als ik vanavond weer thuis ben zal ik wel even voor je kijken. Tenzij iemand me voor is uiteraard

 

[Kramer]

Alvast bedankt.

 

[OctaFish]

Wat wil je precies? Ik snap je bedoeling niet helemaal. De code van Microsoft werkt op zich wel, al is hij gebaseerd op een formulier. Ik heb 'm even aangepast zodat hij nu een msgbox geeft met het resultaat, wellicht kun je 'm zelf aanpassen.

Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
   
   sDir = InputBox("Type the directory that you want to search for", "FileSystemObjects example", "H:\")
   sSrchString = InputBox("Type the file name that you want to search for", "FileSystemObjects example", "vb.ini")
   Screen.MousePointer = 11
   lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
   Screen.MousePointer = 0
   MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
   MsgBox "Total Size = " & lSize & " bytes"
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nDirs As Long, nFiles As Long) As Currency
Dim tFld As Folder, tFil As File, FileName As String
   
    On Error GoTo Catch
    Set fld = fso.GetFolder(sFol)
    FileName = Dir(fso.BuildPath(fld.path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
    While Len(FileName) <> 0
        FindFile = FindFile + FileLen(fso.BuildPath(fld.path, FileName))
        nFiles = nFiles + 1
        MsgBox fso.BuildPath(fld.path, FileName)  ' Load ListBox
        FileName = Dir()  ' Get next file
        DoEvents
    Wend
    
    nDirs = nDirs + 1
    If fld.SubFolders.Count > 0 Then
        For Each tFld In fld.SubFolders
            DoEvents
            FindFile = FindFile + FindFile(tFld.path, sFile, nDirs, nFiles)
        Next
    End If
    Exit Function

Catch:  FileName = ""
    Resume Next
End Function

]
Waarschijnlijk gaat het jou alleen om de functie <FindFile>, die je nodig hebt als vervanger voor de FileSearch. Die kan je vrij letterlijk overnemen, want je voedt de functie met parameters. En die heb je al.

 

[Kramer]

@OctaFish
De bedoeling is dat ik graag de originelen code moet worden aangepast zodat hij in WORD2010 hetzelfde doet als in WORD2003

eigenlijk als ik het zo zie moet het deze 2 stukjes worden aangepast

1.

 ChangeFileOpenDirectory "t:\cor\"

    With Application.FileSearch
        .LookIn = CurDir
        .FileName = strFileName
        If .Execute > 0 Then
            With Dialogs(wdDialogFileSaveAs)
                .Name = "t:\cor\" & strFileName
                .Show
            End With
        Else
            ActiveDocument.SaveAs strFileName
        End If
    End With

en
2.

 With Application.FileSearch
        .LookIn = CurDir
        .FileName = strFileName
        If .Execute > 0 Then
            FSO.DeleteFile strFileName, True
        Else
        End If
    End With

De code die ik in de 1ste post geplaatst heb is onderdeel van een groot sjabloon.
De code is een beetje te groot om hier neer te zetten.

Wat de code nu doet is:
Het bestand kopiëren naar de T:\cor\ (netwerk schijf)
Als deze bestand in de map al bestaat dan komt het scherm opslaan als te voorschijn zodat we achter de bestandsnaam een 1 kan plaatsten,
Anders slaat hij hem op in de map T:\cor\

Daarna wordt de in originelen map het bestand verwijderd. En komt het openen scherm tevoorschijn.

 

[OctaFish]

De functie FindFile gebruikt een aantal parameters, waarvan je er een tweetal in ieder geval moet meegeven: de map en het bestand.

Private Function FindFile(ByVal [B][COLOR="#0000FF"]sFol As String[/COLOR][/B], [B][COLOR="#FF0000"]sFile As String[/COLOR][/B], nDirs As Long, nFiles As Long) As Currency

Jouw code doet ongeveer hetzelfde, dus zoals ik al zei: je weet de variabelen.

    With Application.FileSearch
        .LookIn = [B][COLOR="#0000FF"]CurDir[/COLOR][/B]
        .FileName = [B][COLOR="#FF0000"]strFileName[/COLOR][/B]
        If .Execute > 0 Then
            With Dialogs(wdDialogFileSaveAs)
                .Name = "t:\cor\" & strFileName
                .Show
            End With
        Else
            ActiveDocument.SaveAs strFileName
        End If
    End With

De IF wordt dan vermoed ik zoiets:

        If FindFile(CurDir,strFileName ) > 0 Then
            With Dialogs(wdDialogFileSaveAs)
                .Name = "t:\cor\" & strFileName
                .Show
            End With
        Else
            ActiveDocument.SaveAs strFileName
        End If

 

[Kramer]

FindFile

@OctaFish

Wanneer ik jou code gebruik krijg ik een foutmelding op FindFile.

foutmelding is:
Compileerfout
Het argument is niet optioneel

 

[OctaFish]

Je hebt de functie toch wel gekopieerd?

 

[Kramer]

@octafish
Ik heb alles gekopierd

 

[OctaFish]

Ik maak straks wel even een werkend voorbeeld.

 

[Kramer]

Bedankt

Bedankt alvast