Question

我现在正在做的就是报废数据。在完成该过程后，它将弹出msgbox“已完成”并且新文件包含将保存到网络路径的数据。我的问题是。我需要添加什么代码才能添加。刮擦操作完成后，它将自动打开由废料工具创建的新文件。

这是我的代码

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

假设您保存了一些文件，例如“xyz.xlsx”，打电话给

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

它将做的是启动cmd提示作为启动程序的管道已注册xlsx。它适用于任何已注册的扩展名，例如pdf。

Answer 2

如果DBook是您想要保持打开的文件，那么我可能会改变它：

DBook.SaveCopyAs FilePath
DBook.Close False

要：

DBook.SaveAs FilePath

这将使工作簿保持打开状态，并且您已经保存了它。只需保持开放状态，用户就可以随心所欲。至于SaveCopyAs，您认为不需要保存未保存工作簿的副本，对吧？玩得开心！

完成操作后打开excel新文件

2 个答案: