| 
    
     |  | ▼Yuki さん: >  DT = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\"
 >
 >の変わりに
 >DT = 取得したフォルダ名
 >でいいですよ。
 
 
 ご指摘の通りやってみたのですが、内容が力量不足でよくわからなく。。
 
 Sub test3()
 Application.ScreenUpdating = False
 Dim wb As Workbook, ws As Worksheet, i As Long, myFile
 myFile = Application.GetOpenFilename _
 (filefilter:="サンプルファイル,*.slk", _
 Title:="ファイルを選択", MultiSelect:=True)
 If TypeName(myFile) = "Boolean" Then Exit Sub
 
 With Application.FileDialog(msoFileDialogFolderPicker)
 If .Show = True Then
 Dim DT As String
 DT = CreateObject("WScript.Shell").SpecialFolders.SelectedItems(1)
 End If
 End With
 For i = 1 To UBound(myFile)
 Set wb = Workbooks.Open(myFile(i))
 strNM = Replace(Dir(myFile(i)), ".slk", ".xls")
 wb.SaveAs Filename:=DT & strNM, _
 FileFormat:=xlExcel7, Password:="", _
 WriteResPassword:="", ReadOnlyRecommended:=False, _
 CreateBackup:=False
 wb.Close False
 Set wb = Nothing
 Next i
 Application.ScreenUpdating = True
 
 
 End Sub
 
 |  |