PHPからJavascriptにデータ渡し（Ajaxを使わないで）

　会員番号管理WebDBを作成するには会員番号のダブリチェックが必要になる。必要な項目を全て入力し登録ボタンでDB登録に遷移した後にダブリチェックする方法だと、ダブッていた場合に入力画面に戻ったときに入力データを元に処理が必要となる。面倒なので会員番号入力時（番号入力からファーカスが外れたとき）にチェックすることにした。会員番号入力時に画面遷移してPHPからDB問い合わせをする方法が直ぐに思いつくが、画面遷移でチラチラする。Ajaxを使用してDB問い合わせすると簡単に実装できるが、PHP側からJavascriptにデータを渡す方法で実装してみた。

概要

• PHPにて会員番号入力画面の先頭で会員番号リストを作成
• Javascriptに会員番号リストを渡す（echoでJavascriptに書き出す）
• 会員番号入力テキストボックスからフォーカスが外れたとき(onblur)、Javascriptにて入力値と会員番号リストを比較

実際のコード

*** PHP部
//会員リスト作成
$sql = "SELECT 会員番号 FROM tbl_会員マスタ ORDER BY 会員番号";
$result = mysql_query($sql, $link) or die("検索に失敗しました。");
$kaiin_list = array();
while($row = mysql_fetch_assoc($result)) {
	$kaiin_dt .= $row['会員番号'].",";
}
$kaiin_dt = mb_substr($kaiin_dt,0,-1);                               //最後の","削除

*** Javascript部


*** HTML部（会員番号入力部分）
会員番号;

Excelで簡単なファイル名操作ツール

　大量のデータ処理を行っていると、ファイル名変更、ファイル名一覧取得を簡単に行うツールが欲しくなったのでExcelで作成してみた。

概要

• ディレクトリ内ファイル名一覧の取得
• ディレクトリ内ファイル名の一括名前変換

Code

Sub getFileName()
    Worksheets("ファイル名一覧").Activate
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then  'アクションボタンがクリックされた
            FolderPath = .SelectedItems(1)
        Else                'キャンセルボタンがクリックされた
            FolderPath = ""
        End If
    End With
    
    If FolderPath <> "" Then
      FileSearch 6, "" & FolderPath & "", "" & FolderPath & "" '探すフォルダ、1は表示行の初期値"
    End If
    
End Sub

Sub FileSearch(r As Long, folder As String, fixFolder As String)
    Dim fso As Object
    Dim file As Object
    Dim fld As Object
    Set fso = CreateObject("Scripting.FileSystemObject") 'FSOオブジェクト

    'フォルダ内のファイル表示
    For Each file In fso.GetFolder(folder).Files 'フォルダ内のファイルを順に
        subFolder = Replace(folder, fixFolder, "")
        If subFolder <> "" Then
           subFolder = Mid(subFolder, 2, Len(subFolder) - 1)
        End If
           Range("B" & r).Value = subFolder
           Range("A" & r).Value = file.Path 'A列にフルパス
           Range("C" & r).Value = file.Name 'C列にファイル名
           r = r + 1 '表示行+1
    Next
 
    'フォルダ内のフォルダ検索(再帰処理)
    For Each fld In fso.GetFolder(folder).SubFolders 'フォルダ内のフォルダ(サブフォルダ)を順に
        FileSearch r, fld.Path, fixFolder 'フォルダ内検索(再帰処理)
    Next

    Set fso = Nothing '後始末
End Sub

Sub rename()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then  'アクションボタンがクリックされた
            FolderPath = .SelectedItems(1)
        Else                'キャンセルボタンがクリックされた
            FolderPath = ""
        End If
    End With
    
    ChDir FolderPath
    Worksheets("ファイル名変更").Activate
    
    On Error Resume Next
    i = 6
    Do
        If Range("D" & i).Value = 1 Then
           
            If Range("B" & i).Value <> "" Then
                Name Range("B" & i).Value & "\" & Range("C" & i).Value As Range("B" & i).Value & "\" & Range("A" & i).Value
            Else
                Name Range("C" & i).Value As Range("A" & i).Value
            End If
        
            If Err > 0 Then MsgBox ("Error: " & Error & vbCrLf & Range("C" & i).Value)
         End If
        i = i + 1
        
        If Range("A" & i).Value = "" Then
            Exit Do
        End If
    Loop

End Sub

Sub dataClear()
    Worksheets(1).Activate
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    If lastRow > 5 Then
        i = 6
        Do
            Range(Cells(i, 1), Cells(i, 3)).Value = ""
            If i = lastRow Then
                Exit Do
            End If
            i = i + 1
        Loop
    End If
End Sub

サンプル
実際のExcel　ファイルはこちら

• ダウンロードしたExcelファイル(fileNameChange.xlsm)を起動するとセキュリィ警告がでますが、[コンテンツの有効化]ボタンをクリック
• 指定フォルダー内のファイル名一覧シート

実行(フォルダ選択)ボタンを押すとフォルダ選択ダイアログが表示されますので、フォルダを選択するとファイル名が表示されます。

• ファイル名変更シート

ファイル名を変更したいファイルがあるフォルダーにこのexcelを置き起動する。変更前ファイル名、変更後ファイル名、実行flgに１を入力後「実行」ボタンを押すとファイル名が変更されます。

PHPでディレクトリ丸ごとコピーではまる

　Windows上のPHPで運用しているサイトをWeb上でバックアップを取る必要でた。PHPでディレクトリ丸ごとコピーをネットで検索すると、簡単に色んなサイトで以下のコードが見つかる。これ幸いと思い何も考えずそのまま使用した。

//PHPの内部エンコードはUTF-8
//------------------------------------------------------------------------------
// ディレクトリ階層以下のコピー
// 引数: コピー元ディレクトリ、コピー先ディレクトリ
// 戻り値: 結果
function dir_copy($dir_name, $new_dir)
{
  if (!is_dir($new_dir)) {
    mkdir($new_dir);
  }
 
  if (is_dir($dir_name)) {
    if ($dh = opendir($dir_name)) {
      while (($file = readdir($dh)) !== false) {
        if ($file == "." || $file == "..") {
          continue;
        }
        if (is_dir($dir_name . "/" . $file)) {
          dir_copy($dir_name . "/" . $file, $new_dir . "/" . $file);
        }
        else {
          copy($dir_name . "/" . $file, $new_dir . "/" . $file);
        }
      }
      closedir($dh);
    }
  }
  return true;
}

　結果をみるとエラーもしていないのに、コピーされるはずの日本語ファイル名の一部がコピーされていない。コードを見直してみるとcopy()の返り値を見ていない。これではcopyが失敗しても判らない。エラー処理を追加して失敗するファイル名を調べると、失敗するのはShift_JISの２バイト目が「5C」（ASCII　バックスラッシュ）が含まれているファイル名らしい。

漢字	表	予	能	申	ソ	十	構	暴	圭	貼
コード	95 5C	97 5C	94 5C	90 5C	83 5C	8F 5C	8D 5C	96 5C	8C 5C	93 5C

　PHPのcopy()関数がShift_JIS文字コードの２バイト名に「5C」を含む場合上手く処理できないので、copy()を使う限りディレクトリ丸ごとコピーが上手くいかない。Shift_JISコードを作った人、もう少し考えて欲しかったなーあ。

そこで、Windows　コマンドプロンプトのxcopyコマンドを使用してディレクトリ丸ごとコピー関数を作り目的を達することが出来きました。

ｆunction dir_copy($dir_name, $new_dir) {
　　　$ret = system('xcopy '.$dir_name.' '.$new_dir.' /E /Y /Q /I', $ret);
	return $ret;
}

「差し込み印刷」を使わないでExcelからWordへの差し込み(差し込み印刷もどき)

　Wordの「差し込み印刷」は簡単で便利だが、データソースの指定等の人手作業が
必要であり全自動化できない（私の勉強不足？）。
　そこでWordの「差し込み印刷」を使用しないで同等の機能をExcel VBAで作ってみた。
作成にあたりここを参照させて頂きました。
新しくここにCSVデータを表形式にしてWordに差し込む方式を作成してみました。

概要

• Wordの文書内のExcelデータを差し込む箇所を"{項目名n}"と記述

• Excel側に差し込むデータを以下のように記述

ファイル名	項目名1	項目名2	・・・
ファイル名1	データ11	データ12	・・・
ファイル名2	データ21	データ22	・・・



• Excelの実行ボタンを押すと、項目名nにデータｎを差し込んだファイル名nのWordファイルを作成

サンプル（Excelのデータで請求書をWordで作成作成するサンプル）

• ダウンロード　Wordファイル(template.docx)はこちら、Excelファイル(wordReplacement.xlsm)はこちら
• サンプルのWord、Excelファイルは同じフォルダー内に保存
• Ｅｘｃｅｌファイル（dataReplacement.xlsm）を起動すると、セキュリティの警告がでますがコンテンツの有効化ボタンをクリック。
• 実行ボタンを押すと、表の宛先分の請求書ファイルが同じフォルダーに作成されます。

Excel VBAコード

Option Explicit

 Sub WordDocDupulicate()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Fname   As String
    Dim sOutput As String
 
    Dim mPath   As String
    Dim iRowCount As Long
    Dim jColCount As Long
    Dim sh As Worksheet
    Set wdApp = New Word.Application
 
    Const dataSheet As String = "data"
    Const dataItem  As Long = 3         '項目行
    
    Set sh = Worksheets(dataSheet)
    sh.Select
 
    mPath = ActiveWorkbook.Path & "\"
    Fname = mPath & "template.docx"
 
    sOutput = mPath & "\"
    
    On Error GoTo ErrHandler
    'テンプレート文書
    If Dir(Fname) = "" Then
        MsgBox "テンプレート文書がありません。", vbExclamation
        GoTo ErrHandler
    End If
    
    iRowCount = dataItem + 1         '先頭data行
    
    Do
        With wdApp
            Set wdDoc = .Documents.Open(Fname)
            Set wdRng = wdDoc.Content
        End With
        
        jColCount = 1
        Do
            Debug.Print "項目: " & Cells(dataItem, jColCount).Value
            Debug.Print "置換: " & Cells(iRowCount, jColCount).Value
        
            With wdRng.Find
                .Text = "{" & Cells(dataItem, jColCount).Value & "}"
                .Forward = True
                If Cells(dataItem, jColCount).Value = "日付" Then
                    .Replacement.Text = Format(Cells(iRowCount, jColCount).Value, "gggee年mm月dd日")
                Else
                    .Replacement.Text = Cells(iRowCount, jColCount).Value
                End If
                .MatchCase = False
                .MatchWildcards = False
                .MatchFuzzy = True
                '.Execute Replace:=wdReplaceAll 'Ver Word2003
                .Execute , , , , , , , , , , wdReplaceAll
            End With
            jColCount = jColCount + 1
       Loop Until sh.Cells(iRowCount, jColCount).Value = ""
   
       sOutput = mPath & Cells(iRowCount, 1).Value & ".docx"
       Debug.Print "sOutput: " & sOutput
        
       wdDoc.SaveAs sOutput '保存word文書名
       wdDoc.Close False
       iRowCount = iRowCount + 1
   Loop Until sh.Cells(iRowCount, 1).Value = ""
   wdApp.Quit

ErrHandler:
    If Err.Number > 0 Then
        MsgBox Err.Number & " : " & Err.Description
    Else
        Beep '正常終了
    End If
    Set wdRng = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set sh = Nothing
End Sub

PDFの特定項目にリンク

Webページ毎にPDFのヘルプをリンクする必要があり、しおりでリンクしようとしたが上手くいかない。リンクしたいページでのリンクは出来たが、ページの先頭になり目的の項目を捜すのが面倒。調べた結果以下の方法でリンクできたので備忘録として記載。

pdfのyy ページ内の位置を指定

                          ^^      ^^
                       Page   Page内位置
                              top :    先頭
                              数値：ページ内の位置(現物合せ）

MS Office評価版の期間延長ではまる

Access2003からAccess2013に変換する依頼があった。Access2003はあるがAccess2013は持っていない。このためにAccess2013を買おうかと思ったが、Access2013はえらく高い。この作業為のみに購入するには高すぎ。そこでOffice2013評価版をインストールして作業を行った。試用期間は６０日で変換作業は問題なく終了した。確認のため暫く使いたいので、Webで期間延長の方法を調べて期間延長を行おうとしたがエラーして上手くいかない。

期間延長方法
コマンドプロンプト上で以下のコマンド実行
　"Officeインストールしたフオルダー"\office15\OSPPREARM.EXE

これで延長されるはずであったが、エラーして上手くいかない。
エラーの内容をみても

There was an error when trying to rearm Office. You can try passing the SKU ID as a parameter. Passing the SKU ID is necessary if you are relying on an activation to permit an additional rearm.
Error: 0xc004d307
On a computer running Microsoft Windows non-core edition, run 'slui.exe 0x2a 0xc004d307' to display the error text.

何のことか分からない。
そこでダメ元で管理者権限でコマンドプロンプトを立ち上げてOSPPREARM.EXE
を実行したら、"Microsoft Office rearm successful."というメッセージが出て成功しました。
どこかのサイトで管理者権限のコマンドプロンプト上で実行と書いてあったような気。