'シートに読み込み（言語コードを指定して(エディタクライアント定義専用)）
Sub in_ex_euc_bak(xmlName As String, tabName As String, flg As Integer, pas As String)

' UNIX上で作成されたテキストファイルとして
' 文字コード：EUC-JP 改行コード：LF(\n) として読み込む例
Const adTypeText = 2  ' adTypeBinary = 1
Const adReadLine = -2 ' adReadAll = -1
Const adLF = 10       ' adCR = 13, adCRLF = -1
Dim str As String

If Left(xmlName, 7) = "Client_" Then
     'クライアント定義ファイル場合
    Con = LenB(xmlName) / 2
    sxmlName = Mid(xmlName, 8, Con)
Else
    'サーバ定義ファイル場合
    sxmlName = Replace(xmlName, "_", "\")
End If
If flg <> 0 Then
  With CreateObject("ADODB.Stream")
    .Open
    ' テキストタイプ
    .Type = adTypeText
    ' EUCコード
    .Charset = "EUC-JP"
    ' 改行コードは LF
    .LineSeparator = adLF
    ' 読み込むファイルを指定
    .LoadFromFile Sheets("共通定義").Range("B17") & "\" & pas & "\" & sxmlName & ".xml"
    ' 読み込む位置は先頭から
    .Position = 0
    x = 1
    ' テキストの終わりまで１行ずつ読み込む
    Do Until .EOS
        'MsgBox .ReadText(adReadLine)
        str = .ReadText(adReadLine)
        Sheets(xmlName).Cells(x, 20) = str
        x = x + 1
    Loop
    .Close
  End With
End If

End Sub

'定義ファイルに書き込み（言語コードを指定して(エディタクライアント定義専用)）
Sub out_ex_euc(xmlName As String, tabName As String, pas As String)

Dim myADOstr
'xmlNameシートの貼り付けたデータの総行数
    r = Sheets(xmlName).Range("A65536").End(xlUp).Row
    'ファイル書込み合否をチェック
   
    '①書き込みデータが無い場合
    If r = 1 Then
       Sheets(tabName).Activate
       'エラーのダイアログ
       MsgBox "書き込み失敗しました。書き込み用データがないです。"
       Exit Sub
    End If
    '②キー値が無い場合
     t = WorksheetFunction.CountA(Sheets(tabName).Range("C18:C" & r))
     If t = 0 Then
       Sheets(tabName).Activate
       'エラーのダイアログ
       MsgBox "書き込み失敗しました。書き込みデータにキーの値がないです。"
       Exit Sub
     End If
     '③xmlフォーマットチェック
     For i = 1 To r
        Set obj1 = Sheets(xmlName).Cells(i, 1).Find("<entry key=")
        If Not obj1 Is Nothing Then
            Set obj2 = Sheets(xmlName).Cells(i, 1).Find(Chr(34) & ">")
            If obj2 Is Nothing Then
                Sheets(tabName).Activate
                'エラーのダイアログ
                MsgBox "書き込み失敗しました。書き込み用データのフォーマットが間違っています。"
                Exit Sub
            End If
            Set obj3 = Sheets(xmlName).Cells(i, 1).Find("</entry>")
            If obj3 Is Nothing Then
                Sheets(tabName).Activate
                'エラーのダイアログ
                MsgBox "書き込み失敗しました。書き込み用データのフォーマットが間違っています。"
                Exit Sub
            End If
        Else
            '何もしない
        End If
     Next i
     'サーバ系、クライアント系判断
    If Left(xmlName, 7) = "Client_" Then
        'クライアント定義ファイル場合
        Con = LenB(xmlName) / 2
        sxmlName = Mid(xmlName, 8, Con)
    Else
        'サーバ定義ファイル場合
        sxmlName = Replace(xmlName, "_", "\")
    End If
   
'定義ファイルに書き込み処理
Set myADOstr = CreateObject("ADODB.Stream")
myADOstr.Charset = "EUC-JP" '←重要！ここで文字コード指定。
myADOstr.Open
Dim xlRow As Long
For xlRow = 1 To r
    myADOstr.WriteText (Sheets(xmlName).Cells(xlRow, 1).Text) & vbLf
Next xlRow '↓ファイル名は適切に指定。後ろの「2」は上書きモード
myADOstr.SaveToFile Sheets("共通定義").Range("B17").Text & "\" & pas & "\" & sxmlName & ".xml", 2
myADOstr.Close
Set myADOstr = Nothing

End Sub