อยากให้ชื่อไฟล์ที่เบราขึ้นมาแสดงที่หน้าตารางข้ามชีท

[hutthaya]

maindata.xlsm

อยากให้ชื่อไฟล์ที่ browse ขึ้นมาแต่ละครั้งไปแสดงที่หน้า sheet:MPS COMPARE ที่ cells (3,5) หลังเคื่องหมาย = ค่ะ
จะแยกนำแค่ชื่อไฟล์ C1.2.3 ASIA_Q2'14.xls จาก C:\Users\MPS Comparing\MPS\C1.2.3 ASIA_Q2'14.xls
ช่วยแนะนำแนวทางหน่อยน่ะค่ะคิดไม่ออกแล้วจริงๆค่ะ

[snasui]

Procedure ที่เขียนมาแล้วชื่ออะไร อยู่ Module ใด ติดขัดบรรทัดใดครับ

[hutthaya]

คือตอนนี้สามารถเบราซ์นำชื่อไฟล์มาแสดงที่ช่องเซลได้แล้วค่ะนูอยากให้ไฟล์ c.123 ที่ sheet :data มาแสดงในไฟล์ aindata ที่ sheet :input data MPS ค่ะ จะมีวิธีไหนดึงข้อมูลมาไว้ข้ามไฟล์ได้หรือปล่าวค่ะอาจาร์ย

maindata.xlsm

ไฟล์ที่ใช้ในการ brows

c.123.xlsm

Code: Select all

Option Explicit

Public MPS_NAME As String
'brows1
Sub Browse1()   
Dim FName As Variant
FName = Application.GetOpenFilename(filefilter:="All Files (*.*),*.txt,All Files (*.*),*.*")
If FName <> "False" Then
Sheet7.Cells(25, 3) = FName
End If
End Sub

'brows 2
Sub Browse2()
Dim FName As Variant
FName = Application.GetOpenFilename(filefilter:="All Files (*.*),*.txt,All Files (*.*),*.*")
If FName <> "False" Then
Sheet7.Cells(29, 3) = FName
End If
End Sub
'address file
Function IsFileOpened(StrFilePath As String) As Integer
    Dim FileNum As Integer
     
     'First check filepath exists
    If Len(Dir(StrFilePath)) > 0 Then
        FileNum = FreeFile()
        On Error Resume Next
        Open StrFilePath For Input Lock Read As #FileNum  ' Open file and lock it.
        If Err.Number <> 0 Then
            IsFileOpened = 1 'File open
        Else
            IsFileOpened = 0 'File Closed
        End If
        Close FileNum
    Else
        IsFileOpened = 2 'File not found
    End If
     
End Function
'open file
Public Function OpenFile(filename As String)

    If IsFileOpened(filename) <> 1 Then
      'file is closed/doesn't exist - take appropriate action!
      Workbooks.Open (filename)
      
      'MsgBox ("error open file")
    Else
        On Error GoTo ErrorHandler
        
        Workbooks.Open (filename)
    End If
    
ErrorHandler:
    'MsgBox ("error open file")

End Function

Function isWorkbookExist(newWS As String)
    Dim ws As Worksheet
    isWorkbookExist = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = newWS Then
            isWorkbookExist = True
            Exit For
        End If
    Next
    
End Function

[snasui]

อ่าน Link นี้แล้วเขียนแก้ไขข้อความให้ถูกต้องก่อนครับ viewtopic.php?f=3&t=6100#p39026

[hutthaya]

ขอบคุณค่ะอาจารย์ที่คอยเตือนเสมอ

คือตอนนี้สามารถเบราซ์นำชื่อไฟล์มาแสดงที่ช่องเซลได้แล้วค่ะนูอยากให้ไฟล์ c.123 ที่ sheet :data มาแสดงในไฟล์ aindata ที่ sheet :input data MPS ค่ะ จะมีวิธีไหนดึงข้อมูลมาไว้ข้ามไฟล์ได้หรือปล่าวค่ะอาจารย์

maindata.xlsm

ไฟล์ที่ใช้ในการ brows

c.123.xlsm

Code: Select all

Option Explicit

Public MPS_NAME As String
'brows1
Sub Browse1()   
Dim FName As Variant
FName = Application.GetOpenFilename(filefilter:="All Files (*.*),*.txt,All Files (*.*),*.*")
If FName <> "False" Then
Sheet7.Cells(25, 3) = FName
End If
End Sub

'brows 2
Sub Browse2()
Dim FName As Variant
FName = Application.GetOpenFilename(filefilter:="All Files (*.*),*.txt,All Files (*.*),*.*")
If FName <> "False" Then
Sheet7.Cells(29, 3) = FName
End If
End Sub
'address file
Function IsFileOpened(StrFilePath As String) As Integer
    Dim FileNum As Integer
     
     'First check filepath exists
    If Len(Dir(StrFilePath)) > 0 Then
        FileNum = FreeFile()
        On Error Resume Next
        Open StrFilePath For Input Lock Read As #FileNum  ' Open file and lock it.
        If Err.Number <> 0 Then
            IsFileOpened = 1 'File open
        Else
            IsFileOpened = 0 'File Closed
        End If
        Close FileNum
    Else
        IsFileOpened = 2 'File not found
    End If
     
End Function
'open file
Public Function OpenFile(filename As String)

    If IsFileOpened(filename) <> 1 Then
      'file is closed/doesn't exist - take appropriate action!
      Workbooks.Open (filename)
      
      'MsgBox ("error open file")
    Else
        On Error GoTo ErrorHandler
        
        Workbooks.Open (filename)
    End If
    
ErrorHandler:
    'MsgBox ("error open file")

End Function

Function isWorkbookExist(newWS As String)
    Dim ws As Worksheet
    isWorkbookExist = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = newWS Then
            isWorkbookExist = True
            Exit For
        End If
    Next
    
End Function

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub test()
    Workbooks("c.123.xlsm").Sheets("Data").Range("a1").CurrentRegion.Copy _
       Workbooks("maindata.xlsm").Sheets("input data MPS1").Range("a1")
End Sub

[hutthaya]

แล้วถ้าเกิดไฟล์ที่ brows เข้ามาไม่ได้เป็นชื่อไฟล์ชื่อนี้ตลอดละค่ะอาจารย์
คือจะนำมาจากที่อยู่ของไฟล์อีกทีค่ะ

[snasui]

ก็ต้องให้ตัวแปรกับไฟล์ที่ Browse มาวาง แล้วนำตัวแปรนั้นมาใช้ในการ Copy, วาง ฯลฯ ครับ

[hutthaya]

หนูลองใช้แบบหาตำแหน่งที่อยู่ไฟล์ด้วยวิธีนี้ตามหนังสือก่อนค่ะ
แต่ไม่เข้าใจว่าทำไมถึงดึงข้อมูลจากไฟล์ excel ไม่ได้

Code: Select all

Function getfilesheetdataMPS1()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim wk As Workbook
Dim i As Integer, j As Integer
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Sheet7.Cells(25, 3) & ";Extended Properties=Excel 12.0;"  ' เจอที่อยู่ไฟล์
cn = "SELECT * FROM [Data1$A1:AH20000]"

Workheets.Add
Set ws = ActiveSheet

Set lo = ws.ListObjects.Add( _
              SourceType:=xlSrcQuery, _
              Source:=rs, _
              Destination:=ws.Range("A1"))
              
With lo
  .Name = "Table2"
  .TableStyle = "TableStyleMedium2"
  .QueryTable.Refresh
End With


End Function

[snasui]

cn = "SELECT * FROM [Data1$A1:AH20000]" บรรทัดนี้ไม่น่าจะถูกต้อง

cn คือ Connection String ใช้สำหรับติดต่อกับ Database ปกติจะไม่ Assign SQL statement ให้กับ Connection String แต่สร้างตัวแปรเข้ามาเก็บ SQL statement ไว้ต่างหาก

นอกจากนี้ปกติจะใช้ Recordset เข้ามาเก็บค่าจาก Database ซึ่งก็คือตัวแปร rs ที่เขียนมา แต่จาก Code ที่โพสต์มานั้น ยังไม่ได้ใช้ rs ในการเปิด Connection String และ เรียก SQL Statement แต่อย่างใด

ตัวอย่าง

Code: Select all

...
sql = "select * from" & shtName
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
    & "Data Source=" & sFile & ";" _
    & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open sql, cn
...

[hutthaya]

หนูลองใช้วิธีนี้ดูค่ะอาจารย์คิดว่าอาจจะง่ายกว่าแต่ติดตรง
บรรทัดนี้ Sheets("Data").Activate
พอสั่งเปิดไฟล์ได้แล้วพอจะมาหน้า Data เพื่อที่จะก๊อปปี้ข้อมูลในชีตนี้กลับไม่ได้ค่ะ
ThisWorkbook.Activate 'ตรงนี้เราอ้างถึง pathที่จะเปิดไฟล์ได้ไหมค่ะ

Code: Select all

Sub GetDataMPS()

    Application.ScreenUpdating = False
       MPS1_NAME = Sheet7.Cells(25, 3)

 
OpenFile (MPS1_NAME)
  ThisWorkbook.Activate
    Sheets("Data").Activate
    Cells.Select
    Selection.Copy
    Windows("MPS COMPAIR_rev02.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("MPS COMPARING TOOLS").Select
    

End Sub

[hutthaya]

วิธตัด path ไฟล์ทำยังไงหรอค่ะอาจารย์อยากให้แสดงแค่ชื่อไฟล์ Workbooks(MPS1_NAME) ยังแสดงออกมาทั้ง path เลยค่ะ

Code: Select all

Workbooks(MPS1_NAME).Sheets("Data").Activate

[snasui]

หนูลองใช้วิธีนี้ดูค่ะอาจารย์คิดว่าอาจจะง่ายกว่าแต่ติดตรง
บรรทัดนี้ Sheets("Data").Activate
พอสั่งเปิดไฟล์ได้แล้วพอจะมาหน้า Data เพื่อที่จะก๊อปปี้ข้อมูลในชีตนี้กลับไม่ได้ค่ะ
ThisWorkbook.Activate 'ตรงนี้เราอ้างถึง pathที่จะเปิดไฟล์ได้ไหมค่ะ
...

วิธตัด path ไฟล์ทำยังไงหรอค่ะอาจารย์อยากให้แสดงแค่ชื่อไฟล์ Workbooks(MPS1_NAME) ยังแสดงออกมาทั้ง path เลยค่ะ

Code: Select all

Workbooks(MPS1_NAME).Sheets("Data").Activate

ลองตรวจสอบว่า ThisWorkbook ทีอ้างถึงนั้นคือไฟล์ไหน ถ้าหาก ThisWorkbook ไม่มีชีท Data ก็ย่อมจะเกิด Error

การที่จะ Activate ไฟล์ใด ๆ เราควรจะอ้างถึงตัวแปรที่ให้ไว้กับไฟล์นั้น ยกเว้นอ้างถึง Workbook ที่ทำงานอยู่ปัจจุบัน กรณีอยากทราบว่า ThisWorkbook คือไฟล์ใด สามารถทดสอบด้วยการใช้ MsgBox ThisWorkbook.Name มาช่วยทดสอบ และใช้ ThisWorkbook.Name เพื่อตัดมาเฉพาะชื่อโดยไม่เอา Path ได้

[hutthaya]

สั่งปิดไฟล์ workbook โดยไม่ต้องถาม save หรือไม่ เขียนยังไงค่ะอาจารย์


Workbooks(f).Close

[hutthaya]

ได้หมดแล้วค่ะอาจารย์ ขอบคุณอาจาร์ยที่คอยแนะนำค่ะ

Code: Select all

Sub GetDataMPS1()  'input data mps1
On Error Resume Next
Dim filename As String
Dim Directory As String
Dim FileSource As String
 Dim f As String

    Application.ScreenUpdating = False
    MPS1_NAME = Sheet7.Cells(25, 3)

      f = Dir(Directory) 'use this line for all types or next  line for only xls
   f = Dir(Directory & "*.xls")
    
 
        f = Dir
        If f <> "" Then
                     OpenFile (MPS1_NAME)
                          Workbooks(f).Activate
                          Sheets("Data").Activate
                   Cells.Select
                   Selection.Copy
                   Windows("MPS COMPAIR_rev02.xlsm").Activate
                Sheets("input data MPS1").Activate
                   Range("A1").Select
                   ActiveSheet.Paste
                   
                   
    
        End If

ActiveWorkbook(f).Close savechanges:=False

     
 

End Sub

[hutthaya]

สั่งปิดไฟล์ไม่ได้ค่ะอาจารย์วันนั้นลองแล้วได้แต่พอมาลองรันวันนี้กลับไม่ยอมปิดไฟล์ที่เปิดมาแล้วค่ะ
ActiveWorkbook(s).Close savechanges:=False
พอเข้าเงื่อนไขการปิดไฟล์นี้กลับไม่ยอมปิดค่ะ

Code: Select all

Sub GetDataMPS1()  'input data mps1
On Error Resume Next
Dim MPS1_NAME As String
Dim filename As String
 Dim s As String

    Application.ScreenUpdating = False
    MPS1_NAME = Sheet7.Cells(25, 3)

      s = Dir(MPS1_NAME) 'use this line for all types or next  line for only xls
         
        If s <> "" Then
                         OpenFile (MPS1_NAME)
                          Workbooks(s).Activate
                          Sheets("Data").Activate
                          Cells.Select
                          Selection.Copy
                         Windows("MPS COMPAIR_rev02.xlsm").Activate
                          Sheets("input data MPS1").Activate
                           Range("A1").Select
                            ActiveSheet.Paste
         
        End If
           [color=#FF0000] ActiveWorkbook(s).Close savechanges:=False[/color] 
End Sub

[snasui]

ใน Code ไม่สามารถระบายสีได้ ให้ใช้ Comment เข้าไปแทนครับ

สำหรับ ActiveWorkbook ไม่มี Parameter ครับ ถ้าใส่ไปเป็นเช่น ActiveWorkbook(f) ก็จะ Error เพราะ ActiveWorkbook ถือว่าเป็นไฟล์ปัจจุบันอยู่แล้ว

หากต้องการปิดไฟล์ตามตัวแปร f โดยไม่ Save สามารถใช้ Workbooks(f).Close False ได้ครับ