Прописать в реестре с возможность удаления и восстановления. НО есть один
нюанс при удалении программы ветка останется. (или фиг с ним юзером)

.Програма для людей и я янехочу чтобы она что то
отслеживала по таймеру. ЕЕ задача если TRue then
предупредить Else end. И память не загружать.

А зачем тебе за LOG смотреть

А ти не зможеш предупридить потому щто какой то ламер удалит автозагрузку.Все в твоих руках

Его право

Хозяин компа не прийдет на какую нибудь встречу

Private Declare Function api_SHAddToRecentDocs Lib "shell32.dll" Alias _
"SHAddToRecentDocs" (ByVal dwFlags As Long, ByVal dwData As String) As Long
Private Declare Function api_SHGetSpecialFolderLocation Lib "shell32.dll" Alias _
"SHGetSpecialFolderLocation" (ByVal hwndOwner As Long, _
ByVal nFolder As Long, pidl As Long) As Long
Private Declare Function api_SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDList" (ByVal pidl As Long, ByVal sPath As String) As Long

Public Sub m_CreateShortcut(ScFolder As Variant, ScCaption As String, _
TargetPath As String, Optional ScParam As String, _
Optional StartFolder As String, Optional IcoNum As Integer, _
Optional IcoPath As String, Optional WindowMode As Integer)

'Константы для системных папок:
' 2 = Programs
' 7 = Startup
' 8 = RecentDocs
'16 = Desktop

'Полный путь к временному ярлыку, созданному в папке RecentDocs.
Dim Shortcut0 As String
Dim n0 As Integer 'текущая позиция считывания из файла Shortcut0.
Dim x0 As String * 1 'сюда считываются символы из файла Shortcut0.
Dim l0 As Long 'длина файла Shortcut0.
Dim Shortcut1 As String 'полный путь к создаваемому ярлыку.
Dim n1 As Integer 'позиция считывания в файле Shortcut1
Dim x1 As String * 1 'сюда считываются символы из файла Shortcut1.
Dim l1 As Long 'длина файла Shortcut1.

Dim T As Double
Dim p As Long
Dim i As Integer
Dim x As String
Dim y0 As String * 2

'проверяем параметр ScFolder - указывает целевую папку
If IsNumeric(ScFolder) Then
    ScFolder = p_GetSpecialFolder(CInt(ScFolder))
ElseIf Dir$(ScFolder, vbDirectory) = "" Then
    MsgBox "Указанная папка (" & ScFolder & " не существует!", _
    vbCritical, "Создание ярлыка"
Exit Sub
End If

'создаем временный ярлык в папке RecentDocs, используя путь к целевой папке.
If api_SHAddToRecentDocs(2, TargetPath) > 0 Then

'определяем полный путь к созданному временному ярлыку.
Shortcut0 = p_GetSpecialFolder(8) & "\" & p_File_Folder(TargetPath) & ".lnk"

'Ждем окончания процесса создания ярлыка.
T = Now()
Do Until (Dir$(Shortcut0) <> ""
    If (Now() - T) > 0.00006 Then 'ждем 5 секунд
        If MsgBox("Создание ярлыка задерживается. Продолжить ожидание?", _
        vbQuestion + vbOKCancel, "Создание ярлыка" <> vbOK Then
            Exit Sub
        Else
            T = Now()
        End If
    End If
Loop

'Открываем созданный файл врменного ярлыка для чтения.
n0 = FreeFile()
Open Shortcut0 For Binary Access Read As #n0
'ждем, пока файл будет корректно открыт.
Do Until LOF(n0) > 0
Loop
l0 = LOF(n0)

'открываем файл целевого ярлыка для записи
Shortcut1 = ScFolder & "\" & ScCaption & ".lnk"
n1 = FreeFile()
Open Shortcut1 For Binary Access Write As #n1

'Ищем последний байт, который нужно считать
p = (l0 - 4)
y0 = ""
Do Until (p <= 0) Or (y0 = vbNullChar & vbNullChar)
    Get #n0, p, y0
    p = p - 1
Loop
l1 = p + 2

'Копируем байты
For p = 1 To l1

    Get #n0, p, x0

    Select Case p
        Case 21 'путь к иконке, параметрам и командной строке ярлыка
            i = 3
            If StartFolder <> "" Then
                i = i + 16
            End If
            If ScParam <> "" Then
                i = i + 32
            End If
            If (IcoPath <> "" Or (IcoNum > 0) Then
                i = i + 64
            End If
            x1 = Chr$(i)
        Case 57 'Индекс иконки
            x1 = Chr$(IcoNum)
        Case 61 'Оконный режим запуска
            x1 = Chr$(WindowMode)
        Case Else
            x1 = x0
    End Select

    Put #n1, p, x1

Next p

'Закрываем и удаляем файл временного ярлыка
Close #n0
Kill Shortcut0

'Добавляем иконку, параметры и командную строку в файл целевого ярлыка
x = ""
If StartFolder <> "" Then
    x = x & Chr$(Len(StartFolder)) & vbNullChar & StartFolder
End If
If ScParam <> "" Then
    x = x & Chr$(Len(ScParam)) & vbNullChar & ScParam
End If
If IcoPath = "" Then
    If IcoNum > 0 Then
        x = x & Chr$(Len(TargetPath)) & vbNullChar & TargetPath
    End If
Else
    x = x & Chr$(Len(IcoPath)) & vbNullChar & IcoPath
End If
x = x & String(4, vbNullChar)
Put #n1, l1 + 1, x

Close #n1

Else

    MsgBox "Ошибка создания ярлыка.", vbCritical, "Создание ярлыка"

End If

End Sub

Private Function p_GetSpecialFolder(CsIdl As Long) As String
'возвращаем полный путь к системной папке Windows.

Dim r As Long
Dim pidl As Long
Dim sPath As String

r = api_SHGetSpecialFolderLocation(Application.hWndAccessApp, CsIdl, pidl)

If r = 0 Then

sPath = Space$(260)
r = api_SHGetPathFromIDList(ByVal pidl, ByVal sPath)
If r Then
p_GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If

End If

End Function

Private Function p_File_Folder(FullPath As String) As String
'возвращает короткое имя файла FullPath.

Dim i As Integer

p_File_Folder = FullPath
i = Len(FullPath)
Do Until i = 0
    If Mid$(FullPath, i, 1) = "\" Then
        p_File_Folder = Mid$(FullPath, i + 1)
        i = 0
    Else
        i = i - 1
    End If
Loop

End Function