VBS - 変換.tokyo | henkan.tokyo

【VBS】ネットワークドライブを割り当てる

 
■【VBS】ネットワークドライブを割り当てる
 
今回はドライブマッピング設定のためのVBScriptをご紹介します。
下記のWebサイト「ネットワークドライブを割り当てる」を参考に作成しました。
http://www.whitire.com/vbs/tips0098.html

皆さんの中にも、例えばファイルサーバー上の共有フォルダにドライブマッピングをして利用されている方はいらっしゃると思います。
(起動時、ログオンスクリプトからマッピングさせたり...)
下記のサンプルコードはVBScriptを使ってのドライブマッピングの一例です。
また、ダウンロード用サンプルコードは、下記と同様のVBScriptを組み込んだ「HTAファイル」になります。
(簡易GUI付きのVBScript。ブラウザで開きます)

mapping1.png


■サンプルコード

Option Explicit
On Error Resume Next
Dim objWshNetwork ' WshNetwork オブジェクト
Dim strDrive ' ドライブ名
Dim strPubFolder ' 共有フォルダ名
Dim strUserName ' 接続するユーザー名
Dim strPassword ' パスワード
Set objWshNetwork = WScript.CreateObject("WScript.Network")
If Err.Number = 0 Then
strDrive = "Z:"
strPubFolder = "\\Comp01\Temp"
strUserName = "Administrator"
strPassword = "Password"
objWshNetwork.MapNetworkDrive strDrive, strPubFolder, _
True, strUserName, strPassword
If Err.Number = 0 Then
WScript.Echo strDrive & " ドライブに " & _
strPubFolder & " を割り当てました。"
Else
WScript.Echo "エラー: " & Err.Description
End If
Else
WScript.Echo "エラー: " & Err.Description
End If
Set objWshNetwork = Nothing


■サンプルVBSダウンロード
こちらから


■VBSを作成するのに参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

VBScriptポケットリファレンス改訂版 (Pocket reference) [ アンク ]
価格:2030円(税込、送料無料) (2018/9/15時点)

楽天で購入


【VBS】メールを送信するサンプルコード

 
■【VBS】メールを送信するサンプルコード

今回はWebサイト「CDO.Messageによるメール送信」を参考に作成しました。
http://serialty.blog117.fc2.com/blog-entry-10.html

突然ですが、皆さんなら、メールを送信するプログラムをどのように実装されますか?

コマンドからメール送信を可能にするミドルウェアなんかもありますが、サーバーやクライアントへモジュールをインストールすることなく、簡単にメールを送る方法があります。
この方法を使えば、例えばVBSのようなスクリプトからでも、メールの送信は可能です。

今回は、@Office365などの認証を利用する場合と、AGmailの認証を利用する場合 の2つをご紹介します♪
また、ダウンロード可能なサンプルコードをご用意しました。
こちらはHTAファイル(ブラウザ上で実行されます)でご提供します♪

sample_Mail_send.png


■サンプルコード@

Set objMail = CreateObject("CDO.Message")

objMail.From = "user-from@office365.com"
objMail.To = "user-to@office365.com"
objMail.Subject = "メール送信テスト"
objMail.TextBody = "CDO.Messageによるメール送信テスト"
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user-from@office365.com"
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "passwrd"
objMail.Configuration.Fields.Update

objMail.Send
Set objMail = Nothing


■サンプルコードA

Set objMail = CreateObject("CDO.Message")

objMail.From = "user-from@gmail.com"
objMail.To = "user-to@gmail.com"
objMail.Subject = "SMTP認証、SSL通信によるメール送信テスト"
objMail.TextBody = "CDO.Messageを利用したSMTP認証、SSL通信によるメール送信テスト"
strConfigurationField ="http://schemas.microsoft.com/cdo/configuration/"
With objMail.Configuration.Fields
.Item(strConfigurationField & "sendusing") = 2
.Item(strConfigurationField & "smtpserver") = "smtp.googlemail.com"
.Item(strConfigurationField & "smtpserverport") = 465
.Item(strConfigurationField & "smtpusessl") = True
.Item(strConfigurationField & "smtpauthenticate") = 1
.Item(strConfigurationField & "sendusername") = "user-from@gmail.com"
.Item(strConfigurationField & "sendpassword") = "password"
.Item(strConfigurationField & "smtpconnectiontimeout") = 60
.Update
end With

objMail.Send
Set objMail = Nothing


■サンプルVBSダウンロード
こちらから


■VBSを作成するのに参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

VBScriptポケットリファレンス改訂版 (Pocket reference) [ アンク ]
価格:2030円(税込、送料無料) (2018/9/15時点)

楽天で購入


【VBS】フォルダ内のファイルを一括リネームする


■【VBS】フォルダ内のファイルを一括リネームする

下記のサイト「技術的なこと、あれこれ」を参考にしました。
http://www.sakutyuu.com/technology/?p=1467


サンプルでは、指定したフォルダ内にある拡張子「PDF」ファイルのみを連番でリネームしています。
この指定を変更することで、様々なファイルに対応させることが出来ます。
また、ファイル名は「〇〇〇_連番.pdf」の形式となります。

【VBS】フォルダ内のファイルを一括リネームする.png


■サンプルコード

Const ForReading = 1 '読み込み
Const ForWriting = 2 '書きこみ(上書きモード)
Const ForAppending = 8 '書きこみ(追記モード)

Set FSO = CreateObject("Scripting.FileSystemObject")

'フォルダのパスを取得
target_folder = InputBox("リネーム対象ファイルの保存先フォルダを指定してください。","【PDFファイルリネーム】ファイルの保存先は?")
If Len(target_folder) = 0 Then .Quit

On Error Resume Next
ShowSubfolders FSO.GetFolder(target_folder)
Set FSO = Nothing

Sub ShowSubFolders(Folder)
'フォルダ内のファイルの数を取得
Dim x
x = 0

'ファイルシステムを扱うオブジェクトを作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'フォルダオブジェクトを取得
Set objFolder = objFileSys.GetFolder(Folder)

'ファイルの数を取得(フォルダは除く)
x = objFolder.Files.Count
Dim m
Dim n
m = 0
n = 0
Dim add_txt
add_txt = InputBox("リネームするファイルに付ける名前を指定してください。ファイル名は「〇〇〇_連番.pdf」の形式となります。","【PDFファイルリネーム】ファイルの保存先は?")

For Each File in Folder.Files 'Foler内のファイルを列挙する
On Error Resume Next
Fname = File.name
m = m + 1
'-------------------------------------
Dim strString
Dim strVal
strVal = Fname
strString = Right(strVal, 3)
'PDFファイルの時には連番でリネームする
if strString = "pdf" then
n = n + 1
Dim fs
Dim fn
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
Set fn = fs.GetFile(Folder & "\" & Fname)
Dim rename
rename = add_txt & "_" & n & ".pdf"
fn.Name = rename
Set fs = Nothing
Set fn = Nothing
end if
'-------------------------------------
'※確実に for ~ next ...から離脱させる
if x = m then
exit for
end if

Next

'サブフォルダについても再帰的にリネーム処理する場合
'For Each Subfolder in Folder.SubFolders 'Foler内のフォルダを列挙する
' ShowSubFolders Subfolder '再帰呼び出し
'Next

Set objFileSys = Nothing
Set objFolder = Nothing
Msgbox "リネームが完了しました",,"【PDF用ファイルリネーム】"
End Sub


■サンプルVBSダウンロード
こちらから


■VBSを作成するのに参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

VBScriptポケットリファレンス改訂版 (Pocket reference) [ アンク ]
価格:2030円(税込、送料無料) (2018/9/15時点)

楽天で購入


【VBS】更新日が指定日数以上経過したファイルを再帰的に削除する


■【VBS】更新日が指定日数以上経過したファイルを再帰的に削除する

更新日が指定日数以上経過したファイルを再帰的に削除するVBScriptです。

下記のWebサイト「jfmillet40」を参考に、フォルダ指定方法をアレンジしました。
https://sites.google.com/site/jfmillet40/home/vbscript/memo

更に「DaysOfDeletion」の値をInputboxを使って入力させるようにすれば、汎用性のあるツールになります。


■サンプルコード

Option Explicit

'更新日が何日以上前のファイルを削除するか?
Const DaysOfDeletion = 90

'削除処理をする対象フォルダ
Dim TargetFolderPath

'-----------------------------------
' オブジェクト定義
'-----------------------------------

Dim fso
Dim subf

Dim FileName ' ファイル名
Dim FolderName ' フォルダ名
Dim FDate ' ファイルの更新日

'-----------------------------------
' メイン処理
'-----------------------------------

Dim StartMsg
Dim EndMsg

'フォルダのパスを取得
TargetFolderPath = InputBox("削除対象ファイルの保存先フォルダを指定してください。","【90日経過したファイルを一括削除】保存先フォルダは?")

Set fso = CreateObject("Scripting.FileSystemObject")
Set subf = fso.GetFolder(TargetFolderPath)

If Len(TargetFolderPath) = 0 Then
WScript.Quit
Else
Call FileDel(subf)
End If

EndMsg = MsgBox("「" & TargetFolderPath & "」フォルダ内の" & DaysOfDeletion & "日以上前のファイルを削除しました。",vbOKOnly ,"古いファイルの削除")

'-----------------------------------
' 指定フォルダ直下のファイル削除処理
'-----------------------------------

Dim SubFolder1

Sub FileDel(SubFolder1)

For Each FileName In SubFolder1.Files 'フォルダ内のファイル名を取得

' ファイルの更新日を取得
fdate = FileName.DateLastModified

' 更新日から削除するか否かを判定
if DateDiff("d", fdate, date) >= DaysOfDeletion then
' ファイル削除
fso.DeleteFile FileName
end if

Next

'サブフォルダがある際の処理
Call FolderCheck(SubFolder1)

End Sub

'-----------------------------------
' サブフォルダがある際の処理
'-----------------------------------

Dim SubFolder2

Sub FolderCheck(SubFolder2)

For Each FolderName In SubFolder2.Subfolders 'サブフォルダ名を取得

'サブフォルダ内のファイル削除処理
Call FileDel(FolderName)

Next

End Sub

'-----------------------------------
' オブジェクト開放
'-----------------------------------

set fso = Nothing


■サンプルVBSダウンロード
こちらから


■VBSを作成するのに参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

VBScriptポケットリファレンス改訂版 (Pocket reference) [ アンク ]
価格:2030円(税込、送料無料) (2018/9/15時点)

楽天で購入