Cootje2002
Gebruiker
- Lid geworden
- 12 mei 2013
- Berichten
- 12
Ik heb een aantal word documenten (tabel als formulier opgemaakt) in een directory staan die ik wil omzetten naar gelijk genaamde losse excel files.
Ik wil dat de gebruiker de keuze krijgt de word files te selecteren waarna deze worden omgezet. Het omzetten heb ik al ergens opgesnort
wie kan mij helpen?
Ik wil dat de gebruiker de keuze krijgt de word files te selecteren waarna deze worden omgezet. Het omzetten heb ik al ergens opgesnort
wie kan mij helpen?
Code:
Sub tabel_Data_Word_naar_Excel()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import", _
FileFilter:="Word Files *.docx* (*.docx*),")
''
If FileToOpen = False Then
MsgBox "Geen bestand gekozen.", vbExclamation, "Vergissing???"
Exit Sub
End If
'We declare object variables for Word Application and document
Dim WdApp As Object, wddoc As Object
'Declare a string variable to access our Word document
Dim strDocName As String
'Error handling
On Error Resume Next
'Activate Word it is already open
Set WdApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'Create a Word application if Word is not already open
Set WdApp = CreateObject("Word.Application")
End If
WdApp.Visible = True
'strDocName = "C:\our-inventory\inventory.docx"""
strDocName = FileToOpen
'Check relevant directory for relevant document
'If not found then inform the user and close program
If Dir(strDocName) = "" Then
MsgBox "The file " & strDocName & vbCrLf & _
"was not found in the folder path" & vbCrLf & _
"C:\our-inventory\.", _
vbExclamation, _
"Sorry, that document name does not exist."""
Exit Sub
End If
WdApp.Activate
Set wddoc = WdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName)
wddoc.Activate
'define variables to access the tables in the word document
Dim Tble As Integer
Dim rowWd As Long
Dim colWd As Integer
Dim x As Long, y As Long
x = 1
y = 1
With wddoc
Tble = wddoc.tables.Count
If Tble = 0 Then
MsgBox "No Tables found in the Word document", vbExclamation, "No Tables to Import"
Exit Sub
End If
'start the looping process to access tables and their rows, columns
For i = 1 To Tble
With .tables(i)
For rowWd = 1 To .Rows.Count
For colWd = 1 To .Columns.Count
Cells(x, y) = WorksheetFunction.Clean(.cell(rowWd, colWd).Range.Text)
'Access next column
y = y + 1
Next colWd
'go to next row and start from column 1
y = 1
x = x + 1
Next rowWd
End With
Next
End With
'don't save the word
wddoc.Close Savechanges:=False
'Quit Word
WdApp.Quit
'Release system memory allocated to the 2 object variables
Set wddoc = Nothing
Set WdApp = Nothing
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Laatst bewerkt: