FC2ブログ

スポンサーサイト

--–--–-- (--) --:--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

最新PDF

2018–03–01 (Thu) 19:21
久しぶりの更新は、最新PDFを拾ってくるマクロです。
メールをするときにSCANフォルダの起動→名前の変更→添付が面倒だったので省いてしまいました♪

Sub 最新PDF()

Dim strFileName As String
Dim strFilePath As String

strFilePath = "C:\Scan\"
strFileName = fncGetNewFile(strFilePath)

If strFileName = "" Then
MsgBox "ファイルがありません。"
Exit Sub
End If

Dim x As Long
x = 1
Do Until Worksheets("メールpdf").Cells(x, 1) = ""
x = x + 1
Loop
Dim namae As String
namae = InputBox("名前を入力して下さい")
Name strFilePath & strFileName As strFilePath & namae & ".pdf"
Worksheets("メールpdf").Cells(x, 1) = strFilePath & namae & ".pdf"
namae = InputBox("ファイル内容を入力して下さい")
Worksheets("メールpdf").Cells(x, 2) = namae
Worksheets("メールpdf").Cells(x, 2).Copy
End Sub


Public Function fncGetNewFile(strFilePath As String) As String

Dim strFileName As String
Dim tmpFileName As String
Dim time As Date
Dim pretime As Date

tmpFileName = Dir(strFilePath & "*.pdf")

Do Until tmpFileName = ""
pretime = FileDateTime(strFilePath & tmpFileName)
If pretime > time Then
time = pretime
strFileName = tmpFileName
End If
tmpFileName = Dir()
Loop

fncGetNewFile = strFileName

End Function
スポンサーサイト

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。