Export ข้อมูล ให้ชื่อไฟล์เป็นวันที่และเวลาปัจจุบันแบบอัตโนมัติได้ไหมครับ

[Serverchita]

Export ข้อมูล ให้ชื่อไฟล์เป็นวันที่และเวลาปัจจุบันแบบอัตโนมัติได้ไหมครับ

[snasui]

คงต้องอาศัย VBA เข้ามาช่วยครับ

[Serverchita]

คงต้องอาศัย VBA เข้ามาช่วยครับ

หากต้องใช้ VBA อาจารย์มีสูตรแนะนำไหมครับ เอาตั้งแต่โชว์หน้าต่างให้เลือกว่าจะ Save ตรงไหน

[snasui]

VBA เรียกว่า Code ไม่เรียกว่าสูตรครับ

ผมไม่มี Code แนะนำ ลอง Search จาก Google ดู เช่น Link นี้ครับ https://www.google.co.th/search?q=Expor ... e&ie=UTF-8

[Serverchita]

ทำได้แล้วครับ ขอบคุณอาจารย์มากๆครับ

Code: Select all

Dim FD As FileDialog
Dim Title As String
Dim vrtSelectedItem As Variant
Set FD = Application.FileDialog(msoFileDialogSaveAs)
   With FD
     .AllowMultiSelect = False
     .Title = "Save File DataInput"
     .InitialFileName = "DataInput " & Format(Now(), "ddmmyyyyhhnn") & ".xls"
         If .Show = True Then
             For Each vrtSelectedItem In .SelectedItems
                 DoCmd.OutputTo acOutputQuery, "qExportInput", acFormatXLS, vrtSelectedItem, True
             Next vrtSelectedItem
         Else
             MsgBox "No file was selected"
         End If
     End With

[Serverchita]

ติดปัญหา บางครั้งอยากเปลี่ยนชื่อโดยการพิมพ์เอง แต่ปรากฎว่าหลังจากที่ Save ไฟล์แล้ว ไม่สามารถเปิดได้ เพราะไม่มีสกุลของไฟล์
ปัญหานี้เกิดขึ้นเฉพาะเวลาที่เปลี่ยนชื่อเท่านั้นครับ

รูปที่ 1 คือ Format ที่เกิดจากการเขียนด้วย VBA

รูปที่ 2 คือ Format ที่เกิดจากการสร้าง Macro

[snasui]

ไม่เข้าใจครับ

ช่วยลำดับมาว่าเปลี่ยนชื่อในขั้นตอนไหน อย่างไร มาด้วยครับ

[Serverchita]

จากรูปที่1 ในช่อง File name ชื่อไฟล์จะตั้งแบบอัตโนมัติ แต่ในกรณีที่บางคนอยากจะตั้งชื่อไฟล์เอง เช่นพิมพ์ชื่อไฟล์ว่า 1234 หรืออื่นๆ พอ Save ไฟล์แล้ว ไฟล์ไม่สามารถเปิดได้ครับ

แตกต่างจากรูปที่ 2 ที่ช่อง Save as type จะตั้งให้เลยว่าเป็น Excel เท่านั้น

[snasui]

ในการเขียนชื่อไฟล์เอง ได้ระบุนามสกุลไฟล์เข้าไปด้วยไหมครับ

[Serverchita]

ส่วนใหญ่ผู้ใช้งานจะไม่ได้ใส่ครับ เพราะส่วนใหญ่จะไม่รู้เรื่องว่าต้องใช้สกุลของไฟล์ ครับ
ส่วนผมเองรู้ว่าต้องใส่ครับ

[snasui]

เมื่อเป็นเช่นนั้นก็ปรับ Code ให้เพิ่มนามสกุลไฟล์เข้าไปด้วย ไฟล์จะได้มีนามสกุลและเปิดใช้ได้ครับ

[Serverchita]

จาก Code ด้านล่างผมใส่ไว้แล้วครับ แต่ก็ยังไม่ได้

Code: Select all

Dim FD As FileDialog
Dim Title As String
Dim vrtSelectedItem As Variant
Set FD = Application.FileDialog(msoFileDialogSaveAs)
   With FD
     .AllowMultiSelect = False
     .Title = "Save File DataInput"
     .InitialFileName = "DataInput " & Format(Now(), "ddmmyyyyhhnn") & ".xls"
         If .Show = True Then
             For Each vrtSelectedItem In .SelectedItems
                 DoCmd.OutputTo acOutputQuery, "qExportInput", acFormatXLS, vrtSelectedItem, True
             Next vrtSelectedItem
         Else
             MsgBox "No file was selected"
         End If
     End With
     

[Serverchita]

ผมลองหาดูในเว็บแล้ว แต่เป็นคำสั่ง VBA Excel ครับ

ลองทำใน Excel เป็นไปตามที่ต้องการครับ แต่ไม่รู้จะปรับเข้ากับ Access ยังไงครับ

http://www.rondebruin.nl/win/s5/win001.htm

Code: Select all

'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If

[snasui]

แนบตัวอย่างไฟล์ ตัดมาเฉพาะที่เกี่ยวข้องกับกระทู้นี้พร้อม Code ที่ปรับมาเองแล้ว จะได้ช่วยดูได้ครับ

[Serverchita]

แนบตัวอย่างไฟล์ ตัดมาเฉพาะที่เกี่ยวข้องกับกระทู้นี้พร้อม Code ที่ปรับมาเองแล้ว จะได้ช่วยดูได้ครับ

ไฟล์แนบครับ

[snasui]

Code ชื่ออะไร วางอยู่ที่ใด ช่วยลำดับขั้นตอนการทดสอบมาด้วย จะได้เข้าถึงปัญหาโดยไวครับ

ผมยังไม่พบว่ามี Code ตามที่ยกมาด้านบนครับ

[Serverchita]

code จะอยู่ในปุ่ม OK ของ Form ExportInput และ ExportOutput ครับ

[snasui]

ตอนนี้ผมมาใช้อีกเครื่อง ไม่สามารถเปิดไฟล์ได้

โปรแกรมฟ้องว่า Can't find Language DLL msain.dll หากไม่สะดวกแนบไฟล์มาใหม่คงต้องรอวันจันทร์ครับ

[snasui]

ผมทดสอบ Export แล้วไม่พบว่ามีปัญหา สามารถเปิดได้ครับ

[Serverchita]

ขอบคุณครับ

เดี๋ยวผมจะลองปรับ Code ดู