inhoud html bestand overschrijven

[1107972]

Ik zit met een klein probleempje waar ik al de hele ochtend mee zit te stoeien.

Ik heb een excelmap zo opgezet dat in cel AM6 de html-code voor een gehele webpagina staat. Nu wil ik een macro hebben de inhoud van een bestaande HTML pagina overschrijft. Deze pagina heet index.html en staat in dezelfde map als het excelbestand.

Nu is het mij wel geluk via de onderstaande macro. Echter word de data bewerkt waardoor de opmaak verloren gaat. Een " word opgeslagen als "". In onderstaande code heb ik een sheet gemaakt die enkel de inhoud van cel AM6 bevat.

Kan iemand hier mij verder mee helpen?

Sub OPSLAAN1()
Dim sPath As String
Const sFile As String = "index.html"
    
    sPath = Application.ActiveWorkbook.Path & "\" 'waar de Excelfile nu staat/geopend is
    
    Sheets("index.html").Copy 'dit zorgt voor een copie en nieuw workbook in 1 keer!'
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:= _
            sPath & sFile _
            , FileFormat:=xlText, CreateBackup:=False, local:=True
    ActiveWorkbook.Close

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[1107972]

Ik heb nog even verder gezocht en de oplossing gevonden. Zie onderstaande code.

Sub Update()
  On Error GoTo ErrorHandler
  
  Dim Pad As String
  Dim Naam As String
    Dim Locatie As String
  Dim HTML As String
  
  Pad = Application.ActiveWorkbook.Path & "\" 'waar de Excelfile nu staat/geopend is'
  Naam = "index.html" 'naam van het bestand'
  Locatie = Pad & Naam
  HTML = Range("AM6").Value 'nieuw inhoud van het bestand'
  
  Call Vervangen(Locatie, HTML)

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Private Sub Vervangen(filePath As String, replaceWith As String)
                   
Dim nextFileNum As Long
Dim newFileContents As String
  
  ' reopen file and write new contents
 newFileContents = replaceWith
 nextFileNum = FreeFile

  Open filePath For Output As #nextFileNum
  Print #nextFileNum, newFileContents
  Close #nextFileNum

End Sub