[Iska]

Максимальный размер не ограничен, хоть 1000, хоть 5000 строк. При необходимости, я просто перемещу txt файл и всё пойдёт заново »

Спасибо, ясно.

Примерно так:

Код:

Option Explicit

Const adOpenStatic     = 3
Const adLockOptimistic = 3
Const adCmdText        = 1

Dim objConnection
Dim objRecordset

Dim strPath2DB
Dim strTable

Dim strIP
Dim strLastIP
Dim strPreviousIPs


strPath2DB         = WScript.CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\"
strTable           = Replace("PreviousIPList.txt", ".", "#")

Set objConnection  = WScript.CreateObject("ADODB.Connection")
Set objRecordSet   = WScript.CreateObject("ADODB.Recordset")

objConnection.Open _
	"Provider=Microsoft.Jet.OLEDB.4.0;" & _
	"Data Source=" & strPath2DB & ";" & _
	"Extended Properties=""text;HDR=YES;FMT=CSVDelimited"""

SetTable strTable, objConnection

strIP = GetIP()

With objRecordset
	.Open "SELECT TOP 1 * FROM " & strTable & " ORDER BY DateTime DESC", _
		objConnection, adOpenStatic, adLockOptimistic, adCmdText
		
	If .RecordCount > 0 Then
		strLastIP = .Fields.Item("DateTime").Value & vbTab & .Fields.Item("IP").Value
	Else
		strLastIP = "[Отсутствует]"
	End If
	
	.Close
	
	.Open "SELECT * FROM " & strTable & " WHERE IP = '" & strIP & "'", _
		objConnection, adOpenStatic, adLockOptimistic, adCmdText
	
	If .RecordCount > 0 Then
		strPreviousIPs = ""
		
		Do Until .EOF
			strPreviousIPs = strPreviousIPs & .Fields.Item("DateTime").Value & vbTab & .Fields.Item("IP").Value & vbCrLf
			
			.MoveNext
		Loop
		
		MsgBox "Данный IP адрес [" & strIP & "] уже был ранее добавлен в список:" & vbCrLf & strPreviousIPs & vbCrLf & _
			"Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] уже существует"
	Else
		objRecordset.AddNew Array("DateTime", "IP"), Array(Now(), strIP)
		
		MsgBox "IP адрес [" & strIP & "] добавлен в список." & vbCrLf & vbCrLf & _
			"Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] добавлен"
	End If
	
	.Close
End With

objConnection.Close

Set objRecordset  = Nothing
Set objConnection = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function GetIP()
	With WScript.CreateObject("Microsoft.XMLHTTP")
		.open "GET", "http://ifconfig.me/ip", False
		.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
		.send
		
		GetIP = Replace(.responseText, vbLf, "")
	End With
End Function
'=============================================================================

'=============================================================================
Sub SetTable(strTable, objConnection)
	Const adDate  = 7
	Const adWChar = 130
	
	Dim boolTableExists
	
	Dim objCatalog
	Dim objTable
	
	
	boolTableExists = False
	
	Set objCatalog = WScript.CreateObject("ADOX.Catalog")
	Set objCatalog.ActiveConnection = objConnection
	
	For Each objTable In objCatalog.Tables
		If objTable.Name = strTable Then
			boolTableExists = True
			
			Exit For
		End If
	Next
	
	If Not boolTableExists Then
		Set objTable = WScript.CreateObject("ADOX.Table")
		
		objTable.Name = strTable
		
		objTable.Columns.Append "DateTime", adDate
		objTable.Columns.Append "IP", adWChar
		
		objCatalog.Tables.Append objTable
	End If
	
	Set objTable   = Nothing
	Set objCatalog = Nothing
End Sub
'=============================================================================