Fra: "Moka" <moka@sol.dk>
Emne: Application.Filesearch
Dato: 19. november 2003 13:16
Hej,
Jeg har et problem.... Jeg har lavet en excel skabelonen, der gør følgende:
I en navngiven mappe åbnes alle Word dokumenter.. I disse dokumenter er der
felter med værdier som alle skal samles op i et nyt regneark.
Mit problem er så følgende.. Jeg kan godt afvikle makroen, men jeg er også
administrator...det er noget andet for en standardbruger som har en policy,
der afskærer muligheden for at søge eksempelvis i stifinderen. Jeg har søgt
højt og lavt på Internettet og fundet, at der er flere, der er stødt ind i
lignende problemer, men ingen har tilsyneladende de vise sten - måske en af
jer har???
Her er excel-koden....For standard brugere stopper den ved
Application.Filesearch som jo faktisk er hele humlen ved koden?!?!?!
'Option Explicit
Sub Word_Til_Excel()
' Denne kode bruges til at hente værdier fra formular felter i Word
dokumenter
' ,der ligger i en bestemt mappe i filstrukturen og indsætter dem i et excel
' regneark
Dim Tal
'myPath = "P:\test"
'Title = "MultiDocument Search and Replace"
'Message1 = "Enter folder path."
'myPath = InputBox(Message1, Title)
Dim Wordobj As Object
With Application.FileSearch
..LookIn = "P:\test" '"C:\Documents\How to\test" ' where to search
..SearchSubFolders = False ' search the subfolders
..Filename = "*.doc" ' file pattern to match
' if more than one match, execute the following code
If .Execute() > 0 Then
End If
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
' for each file you find, run this loop
For i = 1 To .FoundFiles.Count
' open the file based on its index position
Set Wordobj = CreateObject("word.application")
Wordobj.Application.Visible = True
Wordobj.Documents.Open Filename:=.FoundFiles(i)
' search and replace
Wordobj.ActiveDocument.Unprotect Password:=""
Wordobj.ActiveDocument.FormFields("tal1").Select
Tal = Wordobj.Selection.Range.Text
'MsgBox Tal
'Set Myobject = CreateObject("Excel.Sheet")
'Myobject.Application.Visible = True
' Place some text in the first cell of the sheet.
ExcelSheet.Application.Cells(i, 1).Value = Tal
Wordobj.ActiveDocument.Protect Password:="", NoReset:=True, Type:= _
wdAllowOnlyFormFields
' save and close the current document
Wordobj.ActiveDocument.Close wdDoNotSaveChanges
Wordobj.Quit
Set Wordobj = Nothing
Next i
'Else
' if the system cannot find any files
' with the .doc extension
'MsgBox "No files found."
'End If
End With
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "P:\test\TESTExcel.XLS" '/ overwrites without
asking
Application.DisplayAlerts = True
'ExcelSheet.SaveAs "P:\test\TEST.XLS"
End Sub
Hjælp!!! Moka
|