作業完了後に新しいファイルを開く

Question

私は現在、データを廃棄しています。プロセスが完了した後、msgbox "Completed"が表示され、新しいファイルにはネットワークパスに保存されるデータが含まれます。私の質問は。どのようなコードを追加する必要がありますか。スクレイピング操作が完了すると、スクラップツールによって作成された新しいファイルが自動的に開きます。ここで

は私のコードは、それが何をするか、あなたは、このような「xyz.xlsx」など、いくつかのファイルを保存した

Shell("cmd /c ..pathto...xyz.xlsx") 

よう コール何かを仮定し

Global FilePath As String 
Global strPath As String 


Declare Function WNetGetUser Lib "mpr.dll" _ 
     Alias "WNetGetUserA" (ByVal lpName As String, _ 
     ByVal lpUserName As String, lpnLength As Long) As Long 

    Const NoError = 0 

Sub Clear_Internet_Cache() 
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255" 
End Sub 
''========================================================================================== 
''Copy_Paste function creates the log of excel files with the issues in it 
''========================================================================================== 
Function Copy_Paste() As String 

Dim SourceBook As Workbook 
Dim DBook As Workbook 
Dim strPath As String 
Dim count As Double 
Dim name As String 
Dim TemplateBook, MyTime, Mydate As String 
Dim FileName As String 

Dim directoryName As String 
Dim FY1 As String 
Dim WK As String 
Dim MyInput As Integer 
Dim layer As String 
Dim CrawlerName As String 
Dim fixedpath As String 
Dim region As String 
Dim segment As String 

If Sheet1.Cells(2, 6) = "Upload to Sharedrive" Then 

fixedpath = "\\" 

FY1 = Sheet1.Cells(2, 7) 
WK = Sheet1.Cells(2, 8) 

MyInput = Sheet9.Cells(3, 26) 

CrawlerName = "AIO" 
region = "EMEA" 
segment = Sheet1.Cells(2, 9) 

If MyInput = 1 Then 

layer = "Staging" 

Else 

layer = "Production" 

End If 

    ''''''''''''''''''''''''''''''FOR USER NAME 

     Const lpnLength As Integer = 255 
     Dim status As Integer 
     Dim lpName, lpUserName As String 
     lpUserName = Space$(lpnLength + 1) 
     status = WNetGetUser(lpName, lpUserName, lpnLength) 

     If status = NoError Then 

      lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1) 

     End If 


     ''''''''''''''''''''''''''''''''''''''''''' 

    directoryName = fixedpath & "\" & region 
    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 

    directoryName = fixedpath & "\" & region & "\" & segment 
    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 


    directoryName = fixedpath & "\" & region & "\" & segment & "\" & FY1 
    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 


    directoryName = fixedpath & "\" & region & "\" & segment & "\" & FY1 & "\" & WK 

    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 

    directoryName = fixedpath & "\" & region & "\" & segment & "\" & FY1 & "\" & WK & "\" & layer 

    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 


    directoryName = fixedpath & "\" & region & "\" & segment & "\" & FY1 & "\" & WK & "\" & layer & "\" & CrawlerName 

    If Not DirExists(directoryName) Then 
     MkDir (directoryName) 
    End If 

    strPath = directoryName 


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

TemplateBook = "AIO_Report" 
TemplateBook = Left(TemplateBook, Len(TemplateBook) - 5) 
Mydate = Format(Date, "mmm d yyyy") 
MyTime = Format(Time, "hh:mm:ss") 
MyTime = Replace(MyTime, ":", "_") 
FileName = TemplateBook & "_" & Mydate & "_" & MyTime 
FilePath = "" 
FilePath = strPath & "\" & FileName & "_" & lpUserName & ".xlsx" 



Set SourceBook = ActiveWorkbook 

Set DBook = Workbooks.Add 

SourceBook.Sheets("Bundle List").Cells.copy Destination:=DBook.Sheets("Sheet1").Cells 

DBook.Sheets("Sheet1").name = "Error Report" 

Sheets("Error Report").Select 


With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 


    Range("A1").Select 
    Selection.EntireRow.Select 
    Selection.Delete 

    Range("A1").Select 
    Selection.EntireRow.Select 
    Selection.Delete 


    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 

DBook.SaveCopyAs FilePath 

DBook.Close False 






End If 

Sheets("Bundle List").Select 
Columns("W:An").Select 
Selection.Delete Shift:=xlToLeft 

Columns("a").Select 

MsgBox ("Completed.") 

Application.StatusBar = "" 


End Function 

Answer 1

あるとしてCMDプロンプトを起動することですプログラムを起動するためのコンジットをxlsxに登録 それはpdfのような登録された拡張機能のために働くでしょう。

DBook.SaveCopyAs FilePath 
DBook.Close False 

へ：DBookはあなたが開いたままにしたいファイルがある場合は

Answer 2

、その後、私はおそらくこれを変更したい。これは、開いているブックを残す

DBook.SaveAs FilePath 

、あなたはすでにましたそれを保存しました。ユーザーが自分のやり方をするためには、開いたままにしてください。 SaveCopyAsについては、保存されていないブックのコピーを保存する必要はないと思いますか？楽しむ！