Snasui Excel Forum

Code: Select all

Sub MainCode()
        Dim formBook As Workbook
        Dim wdShare As Workbook
        Dim response As Integer
        Dim r As Range
        Set formBook = ThisWorkbook
        'Set wdShare = Workbooks("DB.xlsx") <== ตัวนี้ซ้ำกับตัวข้างล่างครับ
        Set r = formBook.Sheets("Enterthedata").Range("K1")
        Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")
        Application.ScreenUpdating = False
            If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
                        MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
                Exit Sub
            End If
                Call SOpenDB
                Call PasteData
                Call MainCodeDBCopy
                Call SCloseDB
        Application.ScreenUpdating = True
End Sub

Code: Select all

Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")

Code: Select all

Sub MainCode()
        Dim formBook As Workbook
        Dim wdShare As Workbook
        Dim response As Integer
        Dim r As Range
        Set formBook = ThisWorkbook
        Set wdShare = Workbooks("DB.xlsx")
        Set r = formBook.Sheets("Enterthedata").Range("K1")
        Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")
        Application.ScreenUpdating = False
            If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
                        MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
                Exit Sub
            End If
                Call SOpenDB
                Call PasteData
                Call MainCodeDBCopy
                Call SCloseDB
        Application.ScreenUpdating = True
End Sub

Code: Select all

Sub SOpenDB()
        Dim wbOpen As Boolean    '<== สำหรับสั่งให้เปิดไฟล์ DB.xlsx
        Dim wb As Workbook
        Set wd = Workbooks.Open("C:\Folder\DB.xlsx")
            For Each wb In Workbooks
                If wb.Name = "DB.xlsx" Then
                    wbOpen = True
                End If
            Next wb
            If Not wbOpen Then
                    ChDir "C:\Documents and Settings\Administrator\Desktop\Po"
                    Workbooks.Open Filename:="C:\Documents and Settings\Administrator\Desktop\Po\DB.xlsx", UpdateLinks:=0
            End If
End Sub