Repetera kod

[Tate]

Jag har en kod som ser ut:

 

Private Sub Form_Load()

 

Form1.Show

Dim connect As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set connect = CreateObject("adodb.connection")

Set rs = CreateObject("adodb.recordset")

connect.Open "", "", ""

 

Dim path As String, fil As String

path = "d:\tidning\"

fil = Dir(path, vbNormal)

While fil <> ""

If (GetAttr(path & fil) And vbNormal) = vbNormal Then

 

Dim xmld As New DOMDocument

If xmld.Load(path & fil) Then

 

If xmld.parsed = True Then

 

Dim NodeListTidningar As IXMLDOMNodeList

Dim NodeList As IXMLDOMNodeList, i As Integer, Node As IXMLDOMElement

Dim SQL As String, strNy As String, strAdress As String, strPostnummer As String, _

strPostort As String, strNamn As String, strUppsagning As String

 

' Vi hämtar de noder vi vill ha med hjälp av XPath...

Set NodeList = xmld.selectNodes("//abonnent")

For i = 0 To NodeList.length - 1

 

 

 

' Hämtar alla "tidning"-noder under den aktuella abonnent-noden.

Set NodeListTidningar = NodeList.Item(i).selectNodes("tidning")

For j = 0 To NodeListTidningar.length - 1

SQL = "INSERT INTO TblAbonnent2 (Namn,Adress,Postnummer,Postort,Tidning,Ny,Uppsagning) VALUES("

 

strNy = NodeList.Item(i).Attributes.getNamedItem("ny").Text

 

' Om noden "adress" inte finns så blir det fel här!

strAdress = NodeList.Item(i).selectSingleNode("adress").Text

 

' Om noden "postnummer" inte finns så blir det fel här!

strPostnummer = NodeList.Item(i).selectSingleNode("postnummer").Text

 

' Om noden "postort" inte finns så blir det fel här!

strPostort = NodeList.Item(i).selectSingleNode("postort").Text

 

' Om noden "tidning inte finns så blir det här!

strTidning = NodeListTidningar.Item(j).Text

 

' Om noden "namn" inte finns så blir det fel här!

strNamn = NodeList.Item(i).selectSingleNode("namn").Text

 

' Om noden "tidning" inte finns så blir det fel här!

'strUppsagning = NodeList.Item(i).selectSingleNode("tidning").Attributes.getNamedItem("uppsagning").Text

strUppsagning = NodeListTidningar.Item(j).Attributes.getNamedItem("uppsägning").Text

 

 

SQL = SQL & "'" & strNamn & "','" & strAdress & "','" & strPostnummer & "','" & strPostort & "','" & strTidning & "','" & strNy & "','" & strUppsagning & "')"

'Debug.Print SQL

Set rs = connect.Execute(SQL)

Next

Next

End If

 

Else

With xmld.parseError

MsgBox .errorCode & " " & .reason & vbCrLf & .srcText & " on line " & .Line, vbExclamation

End With

End If

 

End If

Kill (path & fil)

fil = Dir

 

Wend

 

End Sub

 

..

 

Sen vill jag ha en funktion till denna som gör att koden upprepar sig en gång i timmen. hur kan man göra det på bästa vis för att det inte ska sluka upp hiskeligt med minne.

 

[jockesoft]

Kan du inte bara sätta in en timer som släpper en gång i timmen. Då körs ju koden sedan gör ju inte programmet nåt förrän timern släpper. Det kan väl inte ta upp så mycket minne.

 

/Jocke