'******************
' Set sa Password
'******************
'
Sub SetSAPassword

    Dim ServerName , LoginName , NowPassword , NewPassword
    Dim ConStr , objConn , Sql
    Dim ErrNumber , ErrMsg

    ServerName = "ASTAR"
    LoginName = "sa"
    NowPassword = ""
    NewPassword = "NewPassWord"

    'Connection String
    ConStr = "Provider=SQLOLEDB;" & _
                  "Data Source=" & ServerName & ";" & _
                  "Initial Catalog=master;" & _
                  "User ID=" & LoginName & ";" & _
                  "Password=" & NowPassword & ";"

    'ADO接続オブジェクトを取得する
    Set objConn = CreateObject("ADODB.Connection")

    '接続時のエラー対応
    On Error Resume Next

    'サーバーに接続を行う
    objConn.Open ConStr

    '接続結果（エラーコード）を取得し、エラー処理機能を停止する
    ErrNumber = Err.Number
    ErrMsg = Err.Description
    On Error GoTo 0

    If ErrNumber <> 0 Then

        '接続エラーが発生しました
        Set objConn = Nothing

        'エラーメッセージの表示
        MsgBox ErrMsg , , "接続エラーが発生しました"

        '戻る
        Exit Sub

    End If

    'Sql文を作成する
    Sql = "exec sp_password "
    If NowPassword = "" Then
        Sql = Sql & "null , "
    Else
        Sql = Sql & "'" & NowPassword & "' , "
    End If

    If NewPassword = "" Then
        Sql = Sql & "null , "
    Else
        Sql = Sql & "'" & NewPassword & "' , "
    End If

    Sql = Sql & " 'sa' "
    MsgBox Sql , , "実行するSQL文の表示"

    'システムストアドプロシージャを実行する
    On Error Resume Next
    objConn.Execute Sql , , 1

    '接続結果（エラーコード）を取得し、エラー処理機能を停止する
    ErrNumber = Err.Number
    ErrMsg = Err.Description
    On Error GoTo 0

    If ErrNumber <> 0 Then

        'ストアドプロシージャの実行エラーが発生しました
        objConn.Close
        Set objConn = Nothing

        'エラーメッセージの表示
        MsgBox ErrMsg , , "SQL文の実行で、何かエラーが発生しました"

        '戻る
        Exit Sub

    End If

    '新しいパスワードで再接続を行なう
    objConn.Close

    ConStr = "Provider=SQLOLEDB;" & _
                  "Data Source=" & ServerName & ";" & _
                  "Initial Catalog=master;" & _
                  "User ID=" & LoginName & ";" & _
                  "Password=" & NewPassword & ";"

    '接続時のエラー対応
    On Error Resume Next

    'サーバーに接続を行う
    objConn.Open ConStr

    '接続結果（エラーコード）を取得し、エラー処理機能を停止する
    ErrNumber = Err.Number
    ErrMsg = Err.Description
    On Error GoTo 0

    If ErrNumber <> 0 Then

        '接続エラーが発生しました
        Set objConn = Nothing

        'エラーメッセージの表示（おかしい）
        MsgBox ErrMsg , , "再接続ができません"

        '戻る
        Exit Sub

    End If

    '終了します
    MsgBox "パスワードが変更されました!!" , , "終了します"
    objConn.Close
    Set objConn = Nothing
end sub

'***********
' Main
'***********

Call SetSAPassword