Code ที่สำหรับ เลือกไฟล์ มา import
กระทู้เก่าบอร์ด อ.Yeadram

 3,372   13
URL.หัวข้อ / URL
Code ที่สำหรับ เลือกไฟล์ มา import

อยากได้ Code สำหรับ เปิดเลือกไฟล์ที่จะ import ตาม Spec ที่เราได้บันทึกไว้ครับ ลองทำจาก macro แต่มันจะเปลี่ยนไฟล์ไม่ได้ เพราะไฟล์ที่จะใช้เปลี่ยน directory ก็ใช้ macro ไม่ได้ครับ รบกวนด้วยนะครับ

13 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R06227
ไปที่ แมคโคร
เลือก แมคโครตัวที่ต้องการ
เลือกเมนู เครื่องมือ > แมโคร .. > แปลงแมโคร เป็น Visual Basic
จะมี dialog ให้เลือกออบชั่นเสริม อีกสองข้อ ติ๊กออกให้หมด ไม่เอาซักอย่าง แล้วคลิ๊ก "แปลง"
มันจะทำงานซักพัก แล้วจะแจ้งว่า "แปลงเสร็จแล้ว"
พร้อมทั้งเปิดหน้าต่าง VBA มาให้คุณโดยอัตโนมัติ

(ถ้ามันเปิดโมดูลของฟอร์มอื่นๆ ที่ไม่ใช่ของแมโครที่คุณต้องการให้ปิดโมดูลนั้นๆ ออกไปก่อน ป้องกันการสับสน หรือ ให้ดูลิสต์ด้านซ้ายมือ มองหาโมดูลที่ชื่อ "แมโครที่ถูกแปลง- [ชื่อแมโครของคุณ] ")

ลองดูโค้ดที่มันแปลงมาให้ครับ ดูว่าพอจะอ่านเข้าใจไหม ตามมันทันไหม มีโอกาสไหมที่คุณจะเอามันมาดัดแปลงต่อ หรือถ้าไม่เข้าใจเลย ให้คัดลอกมันมาครับ เอามาโพสต์ให้ดูหน่อยครับ อาจจะมีคนช่วยปรับปรุงเปลี่ยนแปลงให้คุณได้

ลักษณะการทำแบบนี้ อาจเรียกได้ว่า "เป็นการเพิ่มความยืดหยุ่นให้กับแมโคร" เพราะโดยปกติแล้ว แมโครมันยังมีข้อจำกัดอยู่บ้าง มันไม่ยืดหยุ่นได้เท่ากับการเขียนโค้ด VBA ครับ
2 @R06231
ขอบคุณครับ จะลองทำดูครับ
3 @R06267
'------------------------------------------------------------
' ImportWHTLine
'
'------------------------------------------------------------
Function ImportWHTLine()

    DoCmd.TransferText acImportDelim, "IVZ_WHTLine Import", "IVZ_WHTLine", "I:\ACF\Private\ACC\@Current_Private_Acc@\C01_Interface data\KP Soft\53.07.30\IVZ_WHTLine.txt", False, ""

End Function

รบกวนด้วยนะครับ คุณ yeadram จะทำยังไงให้สามารถ Browse File ได้ครับ
เพราะ File จะเปลี่ยน Directory ไปเรื่อยๆ ครับ ขอบคุณครับ
4 @R06268
สร้างเท็กซ์บ๊อกซ์ชื่อว่า txtFolderPath แล้วก๊อปปี้ไฟล์ด้านล่างไปไว้ใน Command button

Private Sub Command0_Click() ' CmdOpenFolder

Dim buff As String
Dim strFilter As String

      strFilter = "All File (*.*)" & vbNullChar
        buff = ShowOpenFileDlg(Me.hWnd, strFilter, "C:\")
    Me.txtFolderPath = buff
buff = BrowseFolder("Please select a data folder.")
     If IsNull(buff) Then Exit Sub
     If Trim(buff) < " " Then Exit Sub
     Me.txtFolderPath = buff

End Sub

โค้ดด้านล่างนี้เอาไปไว้ในโมดูล

Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function
5 @R06271
ทีนี้ ก็เอาคำสั่งของคุณ nlek กับคำสั่งของคุณรักน้องบิวท์
มารวมกัน ดังนี้
1 เอา ฟังก์ชั่น BrowseFolde ของคุณรักน้องบิวท์ ไปวางที่โมดูลตามที่ว่า
2 เอาโค้ดของคุณ nlek เข้าไปแทรกใน Sub ตัวอย่างที่คุณ รักน้องบิวท์ ทำมาให้ดู
'------------------------ของคุณรักน้องบิวท์ ไว้บน------------------------------
Dim buff As String
Dim strFilter As String

      strFilter = "All File (*.*)" & vbNullChar
        buff = ShowOpenFileDlg(Me.hWnd, strFilter, "C:\")
    ' Me.txtFolderPath = buff   
buff = BrowseFolder("Please select a data folder.")
     If IsNull(buff) Then Exit Sub
     If Trim(buff) < " " Then Exit Sub
     ' Me.txtFolderPath = buff
' -----------------------ของคุณ nlek มาต่อท้าย ปรับแก้นิดหน่อย-----------------
DoCmd.TransferText acImportDelim, "IVZ_WHTLine Import", "IVZ_WHTLine", buff, False, ""


3 เอาโค้ดทั้งหมดไปวางใน เหตุการณ์ที่คุณ nlek ต้องการ

6 @R06277
ขอบคุณนะครับ ได้ผลยังไงจะแจ้งให้ทราบนะครับ
7 @R06344


มันโชว์ Error แบบนี้ครับ ต้องทำอย่างไรครับ ผม Copy วางถูกมั้ยครับ
8 @R06348
อ้อ ... ผมก็ดูไม่รอบคอบ
คุณ รักน้องบิวท์ เองก็คงไม่ได้เจตนา

คำที่มัน error คือชื่อฟังก์ชั่นที่เราต้องสร้างรอไว้ก่อนครับ พอดี คุณรักน้องบิวท์ ไม่ได้ให้มาด้วย

ผมจำได้คุ้นๆ ว่าเคยเห็นในเว็บบอร์ดนี้มาแล้วอย่างน้อย 1 ครั้ง ก็เลยไปค้นมาให้ครับ ก็เป็นความเห็นของคุณรักน้องบิวท์นั่นเองแหละครับ

คุณ nlek ต้องไปเอาฟังก์ชั่นนั้นมาวางในโมดูลด้วยครับ โค้ดของคุณถึงจะหาย error

ตามไปเก็บตามลิงค์เลยครับ โค้ดที่อยู่ในความเห็นหมายเลข R02785
9 @R06350
ขอบคุณครับ
10 @R06351


มันไม่ได้ครับ มันฟ้องอีกแล้ว อย่าเพิ่งรำคาญกันนะครับ
11 @R06354
ไม่แน่ใจว่าผมก๊อปปี้โค้ดให้ครบหรือเปล่า ตามที่คุณ yeadram แนะนำไว้
แต่ลองเอาโค้ดด้านล่างนี้ไปไว้ในโมดูล แล้วลองดูอีกทีนะครับ

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'Code courtesy of
'Terry Kreft
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pIDL As Long, _
            ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
12 @R06383
ถึง คุณรักน้องบิวท์ รบกวนขอตัวอย่างด้วยครับ ผมได้ลองทำตามแล้วแต่ไม่ได้ครับ

ขอบคุณครับ
13 @R06384
ลองเข้าไปที่กระทู้นี้ดูครับ

http://www.thai-access.com/yeadram_view.php?topic_id=629
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.3330s