สอบถาม Code vba สร้างไฟล์excel โดย Running number

[lifelove]

เรียน อาจารย์ครับ
ผมต้องการ Save file ลง folder โดนให้ file Running seq โดยที่ไม่ซ้ำกัน

11214293.1_DDMMYYY อ่านไฟล์นี้ แล้วสร้าง File ต่อไป
11214293.2_DDMMYYY
11214293.3_DDMMYYY

เขียน VBA แบบไหนครับ

[snasui]

กรณีใช้ VBA จำเป็นต้องเขียนกันมาเอง ติดแล้วค่อยถามกันตามกฎการใช้บอร์ดข้อ 5 ด้านบนครับ

หากยังไม่เคยเขียนต้อ่งค่อย ๆ ศึกษาไปครับ ตัวอย่างบางส่วน

[lifelove]

ผมเขียนให้ Save ได้แล้ว แต่ การ Running number รบกวนอาจารย์ชี้แนะหน่อยครับ

Code: Select all

sub SaveAs_AllSheets_CSV_Format()
Dim sPath
sPath = ThisWorkbook.path & "\"
Dim SaveTodirectory
SaveTodirectory = "D:\ADI\"

txtFileName = Format(Date, "DDMMYYYY")

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In wb.Worksheets
ws.Copy
ActiveWorkbook.SaveAs sPath & 11214293 & "." & &O1& & "_" & txtFileName & ".csv", FileFormat:=xlCSV, local:=True
'ActiveWorkbook.SaveAs SaveTodirectory & 11214293 & "." & &O1& & "_" & txtFileName & ".xlsb", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    txtFileName = Format(Date, "DDMMYYYY")

ActiveWorkbook.Close False


Next ws



Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "done"
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Dim i As Integer
'...Other code
For Each ws In wb.Worksheets
    i = i + 1
    ws.Copy
    ActiveWorkbook.SaveAs sPath & 11214293 & "." & i & O1 & "_" & txtFileName & ".csv", _
        FileFormat:=xlCSV, local:=True
    txtFileName = Format(Date, "DDMMYYYY")
    ActiveWorkbook.Close False
Next ws
'...Other code

[lifelove]

อาจารย์ครับ ลองปรับดูแล้วแต่สร้างแค่ไฟล์เดียวครับ ไฟล์ต่อๆๆไปไม่สร้างครับ

Code: Select all

Sub SaveAs_AllSheets_CSV_Format()
Dim sPath
sPath = ThisWorkbook.path & "\"
Dim SaveTodirectory
SaveTodirectory = "D:\ADI\"

txtFileName = Format(Date, "DDMMYYYY")

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For Each ws In wb.Worksheets
i = i + 1
ws.Copy
ActiveWorkbook.SaveAs sPath & 11214293 & "." & i & O1 & "_" & txtFileName & ".csv", _
        FileFormat:=xlCSV, local:=True
'ActiveWorkbook.SaveAs SaveTodirectory & 11214293 & "." & &O1& & "_" & txtFileName & ".xlsb", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    txtFileName = Format(Date, "DDMMYYYY")

ActiveWorkbook.Close False

Next ws

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "done"
End Sub

[snasui]

ลอง Search การใช้ Dir เพื่อให้เข้าถึงทุกไฟล์ในฟอรัมนี้ครับ

ตัวอย่างครับ viewtopic.php?t=2710, viewtopic.php?t=5836#p37592