Åben *.doc(x) m.fl. filer og gem som text fil (for 15.000 + filer)

Sub fromWrd()
Application.ScreenUpdating = False
Dim i As Long, h As Long, j As Long, l As Long
j = 1
k = 17547
Dim wrdApp As New Word.Application
Set wrdApp = CreateObject("Word.Application")
Dim wrdDoc As Word.Document
'Dim FSO As New Scripting.FileSystemObject
'Set FSO = CreateObject("Scripting.FileSystemObject")
Dim dok As String
Dim sti As String
Dim tæller As Integer
Dim Sagstype As String
Dim Filtype1 As String, Filtype2 As String, Filnr As String
Dim DATO As Date
wrdApp.AutomationSecurity = msoAutomationSecurityLow
Application.DisplayAlerts = True
wrdApp.Visible = false

For i = j To k

On Error Resume Next
Application.StatusBar = "dokument " & i & " af " & k
sti = Range("A" & i) & "\"
tæller = Range("B" & i)
Sagstype = Range("C" & i)
Filnr = Range("D" & i)
Filtype1 = Range("E" & i)
Filtype2 = ".txt"

If Dir("C:\Documents and Settings\Jacob\Dokumenter\Sagerne\" & j & "-" & k, vbDirectory) = "" Then
MkDir "C:\Documents and Settings\Jacob\Dokumenter\Sagerne\" & j & "-" & k
End If

If Dir("C:\Documents and Settings\Jacob\Dokumenter\Sagerne\" & j & "-" & k & "\" & Filnr, vbDirectory) = "" Then
MkDir "C:\Documents and Settings\Jacob\Dokumenter\Sagerne\" & j & "-" & k & "\" & Filnr
Else
End If

dok = sti & tæller & " - " & Sagstype & " - " & Filnr & Filtype1
'Range("F" & i) = FSO.getfile(dok).datelastmodified
Set wrdDoc = wrdApp.Documents.Open(Filename:=dok, AddToRecentFiles:=False)
wrdDoc.SaveAs2 Filename:="C:\Documents and Settings\Jacob\Dokumenter\Sagerne\" & j & "-" & k & "\" & Filnr & "\" _
& tæller & " - " & Sagstype & Filtype2, FileFormat:=wdFormatText, AddToRecentFiles:=False
wrdDoc.Close
Set wrdDoc = Nothing

dok = ""

Next i

Set wrdApp = Nothing
wrdApp.Quit

   
'ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub