'--------------------------------------

'ตัวอย่าง

'--------------------------------------

'ถ้าพอจะดู code เป็นให้เลือกเอา เฉพาะส่วนที่ต้องการ

Option Compare Database

Option Explicit

        Dim xlApp As Excel.Application

        Dim xlBook As Excel.Workbook

        Dim xlSheet As Excel.Worksheet

Sub start()

Dim i As Integer

Dim t As String

Call checkLogin_md.CSVtoExcel

      '  xlApp.Sheets("DataSource").Select

     '   xlApp.Range("F1").Select

For i = 1 To 30    'µÒÁ¨Ó¹Ç¹ rows ËÃ×Í file ·Õè¤ÍÅÑÁ¹ì F  '3 '30 '·´Êͺ´éÇ Ãͺ¹éÍÂæ

xlApp.Sheets("DataSource").Select

If xlApp.Cells(i, 7).Value = "Y" Then

        Call checkLogin_md.Transfer_csv(xlApp.Cells(i, 6).Value) ' "IncPerformance_20121001_162724.csv"

        Call appendToTable

    End If

Next i

MsgBox "Done Done Done"

End Sub

Sub CSVtoExcel()

'µéÍ reference Microsoft excel 14.0 object libraly ´éÇÂ

        Set xlApp = GetObject(, "Excel.Application")  '   àÃÕ¡ãªé Excel ·Õèà»Ô´äÇéáÅéÇ éÒÂÑäÁèà»Ô´µéÍ Create ¡è͹

      '  xlApp.Application.Windows("TempCSV.xlsx").Activate

      xlApp.Workbooks("TempCSV.xlsx").Activate

'      xlapp.Workbooks("TempCSV.xlsx").Save

        xlApp.Sheets("TempCSV").Select

        xlApp.Range("a1").Select

        xlApp.Visible = True

End Sub

Sub Transfer_csv(csv As String) 'ok is work

Dim wnd As Window

Dim sCSVLink As String

Dim ssheet As String

sCSVLink = "//10.112.250.43/increaseperformance/export/" & csv 'IncPerformance_20121001_162724.csv"

ssheet = "TempCSV"

xlApp.Sheets(ssheet).Cells.ClearContents

Workbooks Filename:=sCSVLink

ActiveSheet.Cells.copy

Range("a1").Select

xlApp.Sheets(ssheet).paste

xlApp.Application.DisplayAlerts = False

xlApp.Application.DisplayAlerts = True

xlApp.Application.ScreenUpdating = True

End Sub

Sub appendToTable()

Dim strxls As String

Dim dRange As Range

Dim myClsData As clsData

Set myClsData = New clsData

        strxls = CurrentProject.Path & Chr(92) & "TempCSV.xlsx"

        DoCmd.SetWarnings False

'

'format

'DoCmd.TransferSpreadsheet acImport, 3,"Employees","C:LotusNewemps.wk3", True, "A1:G12"

'

DoCmdQuery "qryDel_excel_data_temp"

'

'define name of data range

'

    'delete existing name

    xlApp.DisplayAlerts = False

    Dim nm As Name

    For Each nm In xlApp.Names

        nm.Delete

    Next nm

'define name of data range

'

'Set dRange = xlApp.Sheets("sheet1").Range(Cells(1, 1), Cells(rObj2.Lastrows, rObj2.LastColumns))

'    xlApp.Names.Add Name:="Post_Data", RefersToR1C1:=dRange

 '

xlApp.Sheets("TempCSV").Select

Set dRange = xlApp.Sheets("TempCSV").Range(xlApp.Cells(1, 1), xlApp.Cells(myClsData.Lastrows, myClsData.LastColumns))

'Set dRange = xlApp.Sheets("TempCSV").Range("A1:U20")

    xlApp.Names.Add Name:="excel_data2", RefersToR1C1:=dRange

'save ecxel

xlApp.Workbooks("TempCSV.xlsx").Save

xlApp.DisplayAlerts = True

'import excel to Excel_data_Temp

DoCmd.TransferSpreadsheet acImport, , "excel_data_temp", strxls, True, "excel_data2"

'append from Excel_data_Temp to exampleData

DoCmdQuery "qry_append"

DoCmd.SetWarnings True

'----------------------------------------------------

'Class module

'

,

Private Sub Class_Initialize()

End Sub

Public Function Lastrows()

Lastrows = ActiveSheet.UsedRange.Rows.Count

End Function

Public Function LastColumns()

LastColumns = ActiveSheet.UsedRange.Columns.Count

End Function

Public Function LastRow_condition(StrCondition As String, ColsData As Integer) As Long

Dim R As Range

Dim i As Long

i = 0

Range(Cells(2, ColsData), Cells(ActiveSheet.UsedRange.Rows.Count, ColsData)).Name = "forCount"

            For Each R In Range("forCount")

                If R.Value = StrCondition Then

                    i = i + 1

                End If

            Next

LastRow_condition = i + 1

End Function

Public Function LastRow_condition2(ColsData As Integer) As Long

Dim R As Range

Dim i As Long

i = 0

Range(Cells(2, ColsData), Cells(ActiveSheet.UsedRange.Rows.Count, ColsData)).Name = "forCount"

            For Each R In Range("forCount")

                If IsDate(R.Value) Then

                    i = i + 1

                End If

            Next

LastRow_condition2 = i + 1

End Function

Public Sub SheetCopy(sh1 As String)

 Sheets(sh1).Select

    Cells.Select

  Selection.copy

End Sub

Public Sub SheetPaste(sh2 As String)

   Sheets(sh2).Select

    Range("A1").Select

    ActiveSheet.paste

End Sub

Public Sub a1(s As String)

Cells(1, 1) = s

End Sub

Public Sub a2(d As String)

Cells(1, 2) = d

End Sub