Just nu i M3-nätverket
Jump to content

Repetera kod


Tate

Recommended Posts

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.

 

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.



×
×
  • Create New...