Loop med oprettelse af fil

hvilken fejl - og hvordan ser dit loop ud?

Undskyld mit sene svar..

Men jeg har vist fundet ud af at det ville være smartere og få ASPtear til at gemme siden for mig.. men nu får jeg denne fejl..


med denne kode:


Dim xObj, strUrl, bDoneSuccessfully, strFile
Set xobj = CreateObject("SOFTWING.ASPtear")
     
'On Error Resume Next

xObj.Referrer = "http://poulsenogpartnere.dk.nt6.unoeuro.com/"
xObj.ForceReload = True

strUrl = Request.ServerVariables("SCRIPT_NAME")
strUrl = "http://poulsenogpartnere.dk.nt6.unoeuro.com/unique.asp?"&usethisurl&""

strFile = Server.MapPath(""&findthecategories("CCpath")&"_"&findthecategories("CCID")&".html")

response.write strUrl & "<br>"
response.write strFile

' URL, action, payload, filename, username, password
bDoneSuccessfully = xobj.Save(strUrl, Request_POST , "test=it", strFile, "", "")

If bDoneSuccessfully Then Response.Write "Written successfully"


Scriptet køres her: hvor jeg som det første 2 linier viser hvad jeg henter og hvad jeg skal udskrive..

http://poulsenogpartnere.dk.nt6.unoeuro.com/pages/create_html_files.asp



Kan du se hvad der går galt?? jeg er helt blank....

Linie 71 hvor fejlen forekommer er:

bDoneSuccessfully = xobj.Save(strUrl, Request_POST , "test=it", strFile, "", "")

hvilken fejl?

Fejlen er:

ASPtear error '800a01f4'
Server returned error information for request
/pages/create_html_files.asp, line 71

Du kan også se den ved at klikke her:
http://poulsenogpartnere.dk.nt6.unoeuro.com/pages/create_html_files.asp

nope - siden kræver login.

jeg kender desværre ikke så meget til ASPTear og fejlen er ikke så brugbar - et lille gæt kunn være at strUrl ikke må indeholde querystring og at method derfor skal være Request_GET (såfremt du stadig har dine to const.

Hejsa

Så har jeg fjernet login og her er scriptet igen, skåret helt ned:

Fejlen er i linie 42 som er:
bDoneSuccessfully = xobj.Save(strUrl, Request_GET , "test=it", strFile, "", "")

På forhånd tak


Set Conn = Server.CreateObject("ADODB.Connection")
    Conn.Open MM_webdatabase_STRING


set findthecategories = Conn.Execute("SELECT * FROM cmscollectioncategories where CCpath <> '' AND CChovedkategori > 0")
do while not findthecategories.eof


if findthecategories("CChovedkategori") = 3 then
usethisurl    = "CCID="&findthecategories("CCID")&"&whatcategory=konkurrencer&PID=132"
end if

if findthecategories("CChovedkategori") = 2 then
usethisurl    = "CCID="&findthecategories("CCID")&"&whatcategory=nyheder&PID=131"
end if

if findthecategories("CChovedkategori") = 1 then
usethisurl    = "CCID="&findthecategories("CCID")&"&whatcategory=projekter&PID=133&PUID="&findthecategories("CCunderkateogi")&""
end if


Dim xObj, strUrl, bDoneSuccessfully, strFile
Set xobj = CreateObject("SOFTWING.ASPtear")
     
'On Error Resume Next

xObj.Referrer = "http://poulsenogpartnere.dk.nt6.unoeuro.com/pages/"
xObj.ForceReload = True

strUrl = Request.ServerVariables("SCRIPT_NAME")
strUrl = "http://poulsenogpartnere.dk.nt6.unoeuro.com/unique.asp?"&usethisurl&""

strFile = Server.MapPath(""&findthecategories("CCpath")&"_"&findthecategories("CCID")&".html")

response.write strUrl & "<br>"
response.write strFile

' URL, action, payload, filename, username, password
bDoneSuccessfully = xobj.Save(strUrl, Request_GET , "test=it", strFile, "", "")

If bDoneSuccessfully Then Response.Write "Written successfully"






    findthecategories.MoveNext
loop
findthecategories.close

Conn.close

har du prøvet de ting jeg foreslog?

Tak for dit svar,

Ja det skulle jeg mene! Jeg har ændret denne linie:

bDoneSuccessfully = xobj.Save(strUrl, Request_POST , "test=it", strFile, "", "")

TIL

bDoneSuccessfully = xobj.Save(strUrl, Request_GET , "test=it", strFile, "", "")

Eller er der en anden måde at gøre det på?

På forhånd tak

joh - altså, jeg skrev jo at din url ikke skulle have parametre med og at disse i stedet skulle sendes i stedet for dit "test=it"

Jeg tror ikke helt jeg forstår hvad du mener? Jeg ved faktisk slet ikke helt hvad "test=it" betyder:), har bare ikke slettet denne, ud fra det eksempel jeg fandt på nettet..

strUrl = "http://poulsenogpartnere.dk.nt6.unoeuro.com/unique.asp?"

bDoneSuccessfully = xobj.Save(strUrl, Request_GET , usethisurl, strFile, "", "")

kommet videre?

Hejsa,

beklager mit sene svar, men ja jeg fik lavet en løsning som jeg lige ligger her :)


kan du ikke smide et svar, som tak for hjælpen :)

    HPID     = request.QueryString("HPID")
    HPID     = replace(HPID, "'","")
   
    if HPID <> "" then
    includethisintosql    = " AND HPID = "&HPID&" "
    end if

    Response.Buffer=true
    Response.Expires=-1
    server.ScriptTimeout = 3600

   
Function funRplFileName(strTxt)
    funRplFileName = funRplFolderName(strTxt)
    funRplFileName = replace(funRplFileName,"/","")
End Function

Function funRplFolderName(strTxt)
    funRplFolderName = replace(strTxt,"\","")
    funRplFolderName = replace(funRplFolderName,":","")
    funRplFolderName = replace(funRplFolderName,"*","")
    funRplFolderName = replace(funRplFolderName,"?","")
    funRplFolderName = replace(funRplFolderName,"""","")
    funRplFolderName = replace(funRplFolderName,"<","")
    funRplFolderName = replace(funRplFolderName,">","")
    funRplFolderName = replace(funRplFolderName,"|","")
    funRplFolderName = replace(funRplFolderName, "æ", "ae")
    funRplFolderName = replace(funRplFolderName, "Æ", "ae")
    funRplFolderName = replace(funRplFolderName, "ø", "oe")
    funRplFolderName = replace(funRplFolderName, "Ø", "oe")
    funRplFolderName = replace(funRplFolderName, "å", "aa")
    funRplFolderName = replace(funRplFolderName, "Å", "aa")   
end function
Sub subCreateHTMLPage(strFolder, strPostFile, strGetURL)
  Dim strWebsite
  Dim strPhysicalPath
  Dim strWritePage
  Dim objTear
  Dim objFolder
  Dim item
  Dim objFile
  Dim objTStream
  Dim strRetrieval
  Dim arrFolder
  Dim arrFileName

  'strWebsite = "http://www.absolutmarkets.com/"
  'strPhysicalPath = "d:\web\localuser\stein-graphic.com\kasper\"
  strWebsite         = thehttppath
  strPhysicalPath    = thedirectpath & "pages\"
  '----------------------------------
  ' Replace invalid Text
  strFolder = replace(strFolder,"\","/")
  strFolder = funRplFolderName(strFolder)
  strPostFile = funRplFileName(strPostFile)
 
  if len(trim(strFolder))>0 then
      if instr(strFolder,"/") = 1 then
        strFolder = Mid(strFolder,2,len(strFolder))
      end if
      if instr(strFolder,"/") = len(strFolder) then
        strFolder = Mid(strFolder,1,(len(strFolder)-1))
      end if
  end if

  arrFolder = Split(strFolder,"/")
 
  ' Create folder
  Set objFolder = Server.CreateObject("Scripting.FileSystemObject")
  for each item in arrFolder
      strPhysicalPath = strPhysicalPath & "/" & item
      If objFolder.FolderExists(strPhysicalPath) = false Then
        objFolder.CreateFolder(strPhysicalPath)
      End If
  next
  Set objFolder = Nothing
     
  '---------------------------------- 

  '---------------------------------- 
  strGetUrl =  strWebsite & strGetURL
  arrFileName = split(strPostFile,".")
  strPostFile = arrFileName(0) & ".html"
  strWritePage = strPhysicalPath & "/" & strPostFile
  '---------------------------------- 

  '---------------------------------- 
  Set objTear = CreateObject("SOFTWING.ASPTear")
  Response.ContentType = "text/html"
  objTear.ConnectionTimeout = 3600
  objTear.ForceReload = True
' response.Write(strGetUrl)
' response.End()

response.write strGetUrl

  strRetrieval = objTear.Retrieve(strGetUrl, 2, "", "", "")
  If Err.Number <> 0 Then
    Response.Write "<b>"
    If Err.Number >= 400 Then
      Response.Write "Server returned error: " & Err.Number
    Else
      Response.Write "Component/WinInet error: " & Err.Description
    End If
    Response.Write "<b>"
    Response.End
  End If
  Set objTear = Nothing
  '---------------------------------- 
 
  '---------------------------------- 
  Set objFile = Server.CreateObject("Scripting.FileSystemObject")
  Set objTStream = objFile.OpenTextFile(strWritePage, 2, True, 0)
  objTStream.Write(strRetrieval)
  Set objTStream = Nothing
  Set objFile = Nothing
  '---------------------------------- 

End Sub

set findmainpage = Conn.Execute("SELECT * FROM htmlpages where HPmainlevel = 1 AND themainstatus <> 'deleted' AND HPredirect = '' "&includethisintosql&"")
do while not findmainpage.eof
   
        HPdirectfolders = findmainpage("HPdirectfolders")
        HPdirectfolders = replace(HPdirectfolders,"\","")
        HPdirectfolders = replace(HPdirectfolders,":","")
        HPdirectfolders = replace(HPdirectfolders,"*","")
        HPdirectfolders = replace(HPdirectfolders,"?","")
        HPdirectfolders = replace(HPdirectfolders,"""","")
        HPdirectfolders = replace(HPdirectfolders,"<","")
        HPdirectfolders = replace(HPdirectfolders,">","")
        HPdirectfolders = replace(HPdirectfolders,"|","")
        HPdirectfolders = replace(HPdirectfolders,".","_")
        HPdirectfolders    = replace(HPdirectfolders, "æ", "ae")
        HPdirectfolders    = replace(HPdirectfolders, "Æ", "ae")
        HPdirectfolders    = replace(HPdirectfolders, "ø", "oe")
        HPdirectfolders    = replace(HPdirectfolders, "Ø", "oe")
        HPdirectfolders    = replace(HPdirectfolders, "å", "aa")
        HPdirectfolders    = replace(HPdirectfolders, "Å", "aa")
        HPdirectfolders = replace(HPdirectfolders,"\","/")

        HPdirectfilename     = findmainpage("HPdirectfilename")
        HPdirectfilename    = replace(HPdirectfilename, " ", "_")
        HPdirectfilename    = replace(HPdirectfilename, "/", "_")
        HPdirectfilename    = replace(HPdirectfilename, "\", "_")
        HPdirectfilename    = replace(HPdirectfilename, "*", "_")
        HPdirectfilename    = replace(HPdirectfilename, "?", "")
        HPdirectfilename    = replace(HPdirectfilename, "&", "_")
        HPdirectfilename    = replace(HPdirectfilename, "%", "_")
        HPdirectfilename    = replace(HPdirectfilename, "æ", "ae")
        HPdirectfilename    = replace(HPdirectfilename, "Æ", "ae")
        HPdirectfilename    = replace(HPdirectfilename, "ø", "oe")
        HPdirectfilename    = replace(HPdirectfilename, "Ø", "oe")
        HPdirectfilename    = replace(HPdirectfilename, "å", "aa")
        HPdirectfilename    = replace(HPdirectfilename, "Å", "aa")
       
 
    strSql= "UPDATE htmlpages SET HPdirectfolders = '" & HPdirectfolders & "', HPdirectfilename = '" & HPdirectfilename & "' WHERE HPID = " & findmainpage("HPID") & ""
    Conn.Execute(strSql)
       
    call subCreateHTMLPage(""&HPdirectfolders&"",""&HPdirectfilename&"","pages.asp?HPID="&findmainpage("HPID")&"")



    findmainpage.MoveNext
loop
findmainpage.close
Conn.close

Jeg kan ikke lige se om mine kommentarer har hjulpet - men her i hvert fald et svar og ellers læg et svar selv og accepter så spm kan blive afsluttet.

underligt jeg kan ikke klikke på dit svar for at give point?

jeg ved ikke hvor du klikker, men funktionen er ikke i stykker da masser af andre har uddelt point :)

Jeg har givet mange points efterhånden, men jeg kan ikke se checkboksene på denne post?? jeg vil ikke selv have points, men håbede på at checkboxen kom frem hvis der var flere...

http://www.smz.dk.dk/svar.jpg

how http://www.smz.dk/svar.jpg

erhm - er du en dobbeltbruger? det er brugeren steingraphic der har oprettet spørgsmålet mens dit brugernavn er andersasp??

Og så lige forklaringen omkring forvirringen mellem de 2 brugere da jeg ellers vil anmelde det for misbrug?

Hejsa,

Ja jeg fandt jeg ud af at jeg havde den anden konto, som jeg dog ikke bruger (tror jeg oprettede en ny konto da jeg engang havde mistet koden til den anden, og har ikke brugt den siden) . Jeg har nu nedlagt den gamle konto!