มีคนถามไว้ที่ 
http://www.access-programmers.co.uk/forums/showthread.php?s=&postid=109747#post109747 
 
ดังนี้ 
I have a set of files that (approx 500) .doc files that I want to convert to txt and  
rename. I know that there is someway to do it for specified filenames but I would  
like to just go down the list of files in the folder and rename them numerically.  
For example:  
 
Existing file names  
KPCR1344.DOC  
KLFD1432.DOC  
QRWCT13.DOC  
STHB4451.DOC  
SGUIW332.DOC  
 
Rename these to  
K1.TXT  
K2.TXT  
Q1.TXT  
S1.TXT  
S2.TXT  
 
How can I go about doing this? I'm using Access 2k on Win98.  
 
Thanks. 
 
ต้องการเปลี่ยนชื่อไฟล์จาก Word ไปเป็น Text File ซึ่งมีประมาณ 500 ไฟล์ ดังตัวอย่างดังนี้ 
จาก 
KPCR1344.DOC  
KLFD1432.DOC  
QRWCT13.DOC  
STHB4451.DOC  
SGUIW332.DOC  
 
เปลี่ยนเป็น  
K1.TXT  
K2.TXT  
Q1.TXT  
S1.TXT  
S2.TXT  
 
 
เมื่อผมเห็นคำถาม ผมก็นึกถึงการเปิดไฟล์และปรับปรุงไฟล์ง่ายด้วย 
 
Open "c:\test.doc" For Input As #1 
 
แล้วถ่ายโอนไฟล์ไปเป็น Text ก็น่าจะได้ครับ 
 
แต่ไม่เป็นเช่นนั้นครับ ผมต้องใช้วิธีการเปิดไฟล์ Doc ใน Word ก่อน แล้วค่อย Save As ให้เป็น Text File แล้วตั้งชื่อให้ได้ตามที่เขากำหนดครับ 
 
โค้ดมีดังนี้ครับ 
 
Private Function fGetFiles2() 
 
    Dim objFS As Object, objFolder As Object 
    Dim objFiles As Object, objF1 As Object 
    Dim strFolderPath As String, strDoc As String 
    Dim I As Integer, J As Integer 
     
    strFolderPath = "i:/test/" 
    Set objFS = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFS.GetFolder(strFolderPath) 
    Set objFiles = objFolder.files 
         
    For I = 65 To 122 
        J = 1 
        For Each objF1 In objFiles 
            strDoc = Left(objF1.Name, 1) 
            If strDoc = Chr(I) And Right(objF1.Name, 3) = "doc" Then 
                OpenDoc strFolderPath & objF1.Name, strFolderPath & strDoc & J 
                J = J + 1 
            End If 
        Next 
    Next I 
     
    Set objF1 = Nothing 
    Set objFiles = Nothing 
    Set objFolder = Nothing 
    Set objFS = Nothing 
  
End Function 
 
Function OpenDoc(strDocName As String, strTxtName As String) 
Dim objWord As Object 
Set objWord = CreateObject("Word.Application") 
With objWord 
    .Visible = False 
    .Documents.Open FileName:=strDocName 
    .ActiveDocument.SaveAs FileName:=strTxtName, FileFormat:=2  'wdFormatText" 
End With 
objWord.Quit 
Set objWord = Nothing 
End Function 
 
ผมลองใช้แบบข้างล่างนี้แล้วไม่ได้ผลครับ 
 
Function Word2Text(strWord As String, strFirst As String) 
Dim strData As String 
Dim strOldFile As String, strNewFile As String 
 
On Error GoTo Err_FileOpen 
 
strOldFile = strWord 
strNewFile = "i:/test/" & strFirst & ".txt" 
 
Open strOldFile For Input As #1 
Open strNewFile For Output As #2 
     
Do While Not EOF(1) 
    Line Input #1, strData 
        Print #2, strData 
Loop 
 
Close #1 
Close #2 
 
Exit_Sub: 
    Exit Function 
 
Err_FileOpen: 
    If Err = 55 Then ' File already open 
        Close #1 
        Close #2 
    Else 
        MsgBox "Run-time error '" & Err & "':" & _ 
            vbCrLf & vbCrLf & Err.Description, vbOKOnly 
    End If 
    Resume Exit_Sub 
 
End Function 
 
ไฟล์ที่ได้มันเป็นขยะแทนข้อความครับ อยากได้ตัวอย่างจริงพร้อมกับไฟล์ Doc ที่จะลองทดสอบ ก็ให้โวยวายในช่องฝากข้อความข้างล่างได้นะครับ