Snasui Excel Forum

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

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

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

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
...

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

Code: Select all

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

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

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