فتح البرنامج وتنشيطه وانهاء الفترة التجريبية

[salahabdo73]

الاخوة الافاضل اريد فتح البرنامج وتنشيطه وانهاء الفترة التجريبية 

answer = MsgBox("Are you sure you want to refresh the code? ", vbQuestion + vbYesNo + vbDefaultButton2, "")
If answer = 6 Then
    UpdateC
End If
End Sub
Sub UpdateC()
Dim twbk, uwbk As Workbook
Dim uwbkPath As String
Dim filedialog As Office.filedialog
Dim module As Object
Dim ftp As New FTPClient
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Dim fileNAme(100)


Set twbk = ThisWorkbook
    
    ftp.Connect Host, UserName, Password
    ftp.DownloadDirectory "/code", ThisWorkbook.Path & "/code"
    ftp.CloseConnection

    i = 0

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(ThisWorkbook.Path & "/code")
    For Each oFile In oFolder.Files
        fileNAme(i) = oFile.Name
        i = i + 1
    Next oFile
    numOfFiles = i - 1
    If numOfFiles >= 0 Then
    Application.ScreenUpdating = True
    
    On Error Resume Next
    twbk.VBProject.Activate
        For k = 0 To numOfFiles
'            MsgBox fileNAme(k)
            If fileNAme(k) = "ThisWorkbook.cls" Then

                For Each Object In twbk.VBProject.VBComponents
                    If InStr(1, Object.Name, "ThisWorkbook", 1) > 0 Then
                        twbk.VBProject.VBComponents.Object.CodeModule.Activate
                        dovde = Object.CodeModule.CountOfLines
                        Object.CodeModule.DeleteLines 1, dovde
                        fname = "ThisWorkbook.cls"
                        filePath = ThisWorkbook.Path & "\code\" & fname
                        ShFile = FreeFile
                        Open filePath For Input As #ShFile
                        ShCode = Input(LOF(ShFile), ShFile)
                        Close #ShFile
                        twbk.VBProject.VBComponents.Item("ThisWorkbook").Activate
                        twbk.VBProject.VBComponents.Item("ThisWorkbook").CodeModule.InsertLines 1, ShCode
                        Kill filePath
                        Exit For
                    End If
                Next
            ElseIf fileNAme(k) = "InvoiceButtons.cls" Then
                For Each Object In twbk.VBProject.VBComponents
                    If InStr(1, Object.Name, "InvoiceButtons", 1) > 0 Then
                        twbk.VBProject.VBComponents.Object.CodeModule.Activate
                        dovde = Object.CodeModule.CountOfLines
                        Object.CodeModule.DeleteLines 1, dovde
                        fname = "InvoiceButtons.cls"
                        filePath = ThisWorkbook.Path & "\code\" & fname
                        ShFile = FreeFile
                        Open filePath For Input As #ShFile
                        ShCode = Input(LOF(ShFile), ShFile)
                        Close #ShFile
                        twbk.VBProject.VBComponents.Item("InvoiceButtons").Activate
                        twbk.VBProject.VBComponents.Item("InvoiceButtons").CodeModule.InsertLines 1, ShCode
                        Kill filePath
                        Exit For
                    End If
                Next
            ElseIf InStr(1, fileNAme(k), ".frx", 1) > 0 Or InStr(1, fileNAme(k), ".frm", 1) > 0 Then  '' ok ok  ok
                If InStr(1, fileNAme(k), ".frm", 1) > 0 Then
                    ime = Replace(fileNAme(k), ".frm", "")
                    ime = Replace(ime, ".frx", "")
                    For Each module In ThisWorkbook.VBProject.VBComponents
                        If module.Name = ime Then
                            ThisWorkbook.VBProject.VBComponents.Remove module
                            Exit For
                        End If
                    Next
                    filePath = ThisWorkbook.Path & "\code\" & fileNAme(k)
                    twbk.VBProject.VBComponents.Import (filePath)
                End If
            Else  '' ok   ok ok
                ime = Replace(fileNAme(k), ".bas", "")
                ime = Replace(ime, ".cls", "")
                For Each module In ThisWorkbook.VBProject.VBComponents
                    If module.Name = ime Then
                        ThisWorkbook.VBProject.VBComponents.Remove module
                        Exit For
                    End If
                Next
                filePath = ThisWorkbook.Path & "\code\" & fileNAme(k)
                ThisWorkbook.VBProject.VBComponents.Import (filePath)
            End If
        Next
    End If
    On Error Resume Next
    oFSO.DeleteFolder ThisWorkbook.Path & "/code"

    ThisWorkbook.Save
'    Application.Quit
End Sub

 

نسخة من eInvoice-ETA-Alexandar.xlsm