ExcelでGoogleサイトマップ用xmlファイル作成ソフトを作ってみよう

Private Sub ExMakeXmlFile()
    Dim lrow As Long
    Dim lcol As Long
    Dim sxml As String
    Dim fno As Integer
    Dim sdir As String
    
    sxml = ""
    
    '作成するサイトアドレスから作成する
    sxml = sxml + "   <url>"
    sxml = sxml & vbCrLf + "      <loc>" & TextBox1.Text & "</loc>"
    sxml = sxml & vbCrLf + "   </url>"
    
    
    'URLがある開始セル位置
    lrow = 11
    lcol = 2
    
    '抽出したURLで構文を作成する
    While Cells(lrow, lcol) <> ""
        sxml = sxml & vbCrLf + "   <url>"
        sxml = sxml & vbCrLf + "      <loc>" & Cells(lrow, lcol) & "</loc>"
        sxml = sxml & vbCrLf + "   </url>"
        lrow = lrow + 1
    Wend
    
    Debug.Print sxml

    sdir = ActiveWorkbook.Path
    If Right(sdir, 1) <> "\" Then
        sdir = sdir & "\"
    End If
    
    'ファイル保存
    fno = FreeFile
    Open sdir & "sitemap.xml" For Output As fno
    Print #fno, TextBox2.Text
    Print #fno, sxml
    Print #fno, TextBox3.Text
    Close fno

End Sub