Snasui Excel Forum

Code: Select all

' ก่อนใช้งานต้องไปติ๊กถูกที่ Microsoft sctipting runtime กับ Microsoft scriplet libraly ก่อนนะ (อันนี้สำคัญนะ)
Application.CutCopyMode = False ' อันนี้เป็นการปิด events บนจอ
Dim c As New FileSystemObject
On Error GoTo x
        c.CreateFolder ("C:\Documents and Settings\All Users\Desktop\TextFile") ' สร้าง Folder ไว้หน้าจอ ถ้ามีแล้วข้ามไปครับ
x:
Myname = InputBox("ระบุชื่อ TextFile ") 'ตั้งอะไรก็ได้ครับ
Set fs = CreateObject("Scripting.FileSystemObject") ' set object กันก่อนครับ
Set a = fs.CreateTextFile("C:\Documents and Settings\All Users\Desktop\TextFile\" & Myname & ".txt", True)
Range("J2").Select
Rem ตรงนี้ ถ้าข้อมูลมีมากกว่า 1 คอลัมน์ก็ใช้ For เพิ่มเข้าไปนะครับ โดย Loop เท่ากับจะนวนคอลัมน์
Do While ActiveCell.Value <> ""
        a.WriteLine ActiveCell.Text
        ActiveCell.Offset(1, 0).Select
Loop
a.Close
MsgBox "เรียบร้อยแล้ว", vbOKOnly