Snasui Excel Forum

Code: Select all

Sub im_stu()
Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("Name.xls")
 If MsgBox("ต้องการนำเข้าข้อมูล", 36, "ยืนยันการนำเข้า") = 6 Then
If WB Is Nothing Then
    MsgBox "ไฟล์ Name.xls ยังไม่ได้เปิด กรุณาเปิดไฟล์ก่อน", vbCritical, "กรุณาเปิดไฟล์"
    Set WB = Nothing
    On Error GoTo 0
  Else
    Windows("Name.xls").Activate
    Range("B2:G550").Select
    Selection.Copy
    Windows("test2.xlsb").Activate
    Sheets("Student").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'        Call rank_stu
        Range("B3").Select
        MsgBox "นำเข้าเรียบร้อย "
        End If
    End If
End Sub

Code: Select all

Sub OpenSingleFile()
    Dim Filter As String, Title As String
    Dim FilterIndex As Integer
    Dim Filename As Variant
    On Error Resume Next
    Filter = "Excel Files (*.xls),*.xls,"
    FilterIndex = 3
    Title = Open Flie : Name.xls"
    ChDrive ("C")
    ChDir ("C:\")
    With Application
        Filename = .GetOpenFilename(Filter, FilterIndex, Title)
        ChDrive (Left(.DefaultFilePath, 1))
        ChDir (.DefaultFilePath)
    End With
    If Filename = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    ImportThisOne CStr(Filename)
 End Sub

Code: Select all

Sub ImportThisOne(sFileName As String)
    Dim oBook As Workbook
    Dim myBook As Workbook
    Set myBook = ThisWorkbook
    Workbooks.Open sFileName
    Set oBook = ActiveWorkbook
    'Now do your processing on the newly imported sheet
    'On Error Resume Next
    'Empty sheet1 of this workbook to prepare for new data:
'    myBook.Sheets("student").UsedRange.Clear
    myBook.Sheets("student").Range("B2:G3500").Clear
    'Copy new sheet into this workbook
    oBook.Worksheets(1).UsedRange.Copy Destination:=myBook.Sheets("student").Range("B2")
    'close text file, do not save changes
    oBook.Close False
    Set oBook = Nothing
 End Sub

Code: Select all

'Other code
    myBook.Sheets("student").Range("B2:G3500").Clear
    'Copy new sheet into this workbook
    oBook.Worksheets(1).Range("B2:G3500").Copy Destination:=myBook.Sheets("student").Range("B2")
'Other code

Code: Select all

Sub ImportThisOne(sFileName As String)
    Dim oBook As Workbook
    Dim myBook As Workbook
    	Set myBook = ThisWorkbook
    	Workbooks.Open sFileName
    	Set oBook = ActiveWorkbook
   	myBook.Sheets("student").Range("B2:G3500").Clear
    	oBook.Worksheets(1).Range("B2:G3500").Copy Destination:=myBook.Sheets("student").Range("B3")
    'Selection.PasteSpecial Paste:=xlPasteValues
    oBook.Close False
    Set oBook = Nothing
 End Sub

Code: Select all

'Other code
oBook.Worksheets(1).Range("B2:G3500").Copy
myBook.Sheets("student").Range("B3").PasteSpecial xlPasteValues
'Other code

Code: Select all

Sub ImportThisOne(sFileName As String)
    Dim oBook As Workbook
    Dim myBook As Workbook
    Set myBook = ThisWorkbook
    Workbooks.Open sFileName
    Set oBook = ActiveWorkbook
    myBook.Sheets("student").Range("B2:G3500").Clear
    oBook.Worksheets(1).Range("B2:G3500").Copy
    myBook.Sheets("student").Range("B2").PasteSpecial xlPasteValues
    oBook.Close False
    Set oBook = Nothing
 End Sub

Code: Select all

 Sub im_stu()
Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("Name.xls")
 If MsgBox("ต้องการนำเข้าข้อมูล", 36, "ยืนยันการนำเข้า") = 6 Then
If WB Is Nothing Then
    MsgBox "ไฟล์ Name.xls ยังไม่ได้เปิด กรุณาเปิดไฟล์ก่อน", vbCritical, "กรุณาเปิดไฟล์"
    Set WB = Nothing
    On Error GoTo 0
  Else
    Windows("Name.xls").Activate
    Range("B2:G1500").Select
    Selection.Copy
    Windows("pp5.xlsb").Activate
    Sheets("Student").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'        Call rank_stu
        Range("B2").Select
        MsgBox "นำเข้าเรียบร้อย "
        End If
    End If
End Sub

Code: Select all

Sub OpenSingleFile()
    Dim Filter As String, Title As String
    Dim FilterIndex As Integer
    Dim Filename As Variant
    On Error Resume Next
    Filter = "Excel Files (*.xls),*.xls,"
    FilterIndex = 3
    Title = "Open Flie Name.xls"
    ChDrive ("C")
    ChDir ("C:\")
    With Application
        Filename = .GetOpenFilename(Filter, FilterIndex, Title)
        ChDrive (Left(.DefaultFilePath, 1))
        ChDir (.DefaultFilePath)
    End With
    If Filename = False Then
        MsgBox "คุณไม่ได้เลือกไฟล์ ยกเลิกการนำเข้าข้อมูล"
        Exit Sub
    End If
    ImportThisOne CStr(Filename)
 End Sub
 
Sub ImportThisOne(sFileName As String)
    Dim oBook As Workbook
    Dim myBook As Workbook
    Set myBook = ThisWorkbook
    Workbooks.Open sFileName
    Set oBook = ActiveWorkbook
    myBook.Sheets("student").Range("B2:G3500").Clear
    oBook.Worksheets(1).Range("B2:G3500").Copy
    myBook.Sheets("student").Range("B2").PasteSpecial xlPasteValues
    oBook.Close False
    Set oBook = Nothing
 End Sub

Code: Select all

Sub im_stu()
Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("Name.xls")
 If MsgBox("ต้องการนำเข้าข้อมูล", 36, "ยืนยันการนำเข้า") = 6 Then
If WB Is Nothing Then
    MsgBox "ไฟล์ Name.xls ยังไม่ได้เปิด กรุณาเปิดไฟล์ก่อน", vbCritical, "กรุณาเปิดไฟล์"
    Set WB = Nothing
    On Error GoTo 0
  Else
    Windows("Name.xls").Activate
    Range("B2:G1500").Select
    Selection.Copy
    Windows("pp5.xlsb").Activate
    Sheets("Student").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'        Call rank_stu
        Range("B2").Select
        MsgBox "นำเข้าเรียบร้อย "
        End If
    End If
End Sub

Code: Select all

Sub OpenSingleFile()
    Dim Filter As String, Title As String
    Dim FilterIndex As Integer
    Dim Filename As Variant
    On Error Resume Next
    Filter = "Excel Files (*.xls),*.xls,"
    FilterIndex = 3
    Title = "Open Flie Name.xls"
    ChDrive ("C")
    ChDir ("C:\")
    With Application
        Filename = .GetOpenFilename(Filter, FilterIndex, Title)
        ChDrive (Left(.DefaultFilePath, 1))
        ChDir (.DefaultFilePath)
    End With
    If Filename = False Then
        MsgBox "คุณไม่ได้เลือกไฟล์ ยกเลิกการนำเข้าข้อมูล"
        Exit Sub
    End If
    ImportThisOne CStr(Filename)
 End Sub
 
 [code]
Sub ImportThisOne(sFileName As String)
    Dim oBook As Workbook
    Dim myBook As Workbook
    Set myBook = ThisWorkbook
    Workbooks.Open sFileName
    Set oBook = ActiveWorkbook
    myBook.Sheets("student").Range("B2:G3500").Clear
    oBook.Worksheets(1).Range("B2:G3500").Copy
    myBook.Sheets("student").Range("B2").PasteSpecial xlPasteValues
    oBook.Close False
    Set oBook = Nothing
 End Sub