フロッピーにドキュメントコピーを自動的に保存する（Microsoft Word）

Sub FileCopyToA()

Dim OrName As String     OrName = ActiveDocument.FullName     ActiveDocument.SaveAs "A:\" + ActiveDocument.Name     ActiveDocument.SaveAs OrName End Sub

Sub DoubleCopy()

Dim Message As String, Title As String     Dim Default As String, Drive As String     Dim ffname as String, fname as String

On Error GoTo Quit     Message = "Enter drive letter for document (A, C, D)"

Title = "Send Document to File"

Default = "A"



' Display message, title, and default value     Drive = InputBox(Message, Title, Default)

If Drive > "" Then         ffname = ActiveDocument.FullName         fname = Drive & ":\" & ActiveDocument.Name         ActiveDocument.SaveAs fname         ActiveDocument.SaveAs ffname     End If     Quit:

End Sub

Sub SentToDriveA()

If ActiveDocument.Saved = False Then ActiveDocument.Save     System.Cursor = wdCursorWait     OrigLongFileName = ActiveDocument.Name     OldPath = ActiveDocument.Path & Application.PathSeparator     If ActiveDocument.Path = "" Then         MsgBox "Please save this document before sending to drive A:", _            vbOKOnly, "This Document Not Saved"

Else         Documents(ActiveWindow.Caption).Close         FileCopy OldPath & OrigLongFileName, "a:\" & OrigLongFileName         Documents.Open FileName:=OldPath & OrigLongFileName         Application.GoBack     End If     System.Cursor = wdCursorNormal End Sub

Public Sub CopyToA()

Dim docActive As Document     Dim docNew As Document     Dim rngActiveDocPart As Range     Dim rngNewDocPart As Range     Dim strDocName As String     Dim strTemplateName As String

' reference the current document     Set docActive = ActiveDocument

' get the name of doc and also path/name     ' of the template it's based-on     strDocName = docActive.Name     strTemplateName = docActive.AttachedTemplate.FullName

' create a copy document based on same template     Set docNew = Documents.Add(strTemplateName)



' loop to copy each part of the active doc to the new doc     For Each rngActiveDocPart In docActive.StoryRanges         ' reference same part         Set rngNewDocPart = docNew.StoryRanges _            (rngActiveDocPart.StoryType)

rngActiveDocPart.Copy         rngNewDocPart.Paste     Next rngActiveDocPart

' make the new document active     docNew.Activate

' offer to save it on floppy drive A:\     With Dialogs(wdDialogFileSaveAs)

.Name = "A:\" & strDocName         .Show     End With End Sub