獲取的OneDrive

Question

特定文件夾中任何人都可以給我在OneDrive中的特定文件夾中的每個文件獲取共享鏈接（編輯）的VBA（Excel）中代碼的示例文件的共享鏈接？ 還是一個有用的鏈接？

感謝 鐸

Answer 1

我不知道你問什麼，但也許正是這種...

Sub GetFolder_Data_Collection() 

Range("A:L").ClearContents 
Range("A1").Value = "Name" 
Range("B1").Value = "Path" 
Range("C1").Value = "Size (KB)" 
Range("D1").Value = "DateLastModified" 
Range("E1").Value = "Attributes" 
Range("F1").Value = "DateCreated" 
Range("G1").Value = "DateLastAccessed" 
Range("H1").Value = "Drive" 
Range("I1").Value = "ParentFolder" 
Range("J1").Value = "ShortName" 
Range("K1").Value = "ShortPath" 
Range("L1").Value = "Type" 
Range("A1").Select 

Dim strPath As String 
'strPath = "I:\Information Security\KRI Monthly Data Collection\" 
strPath = GetFolder 

Dim OBJ As Object, Folder As Object, File As Object 

Set OBJ = CreateObject("Scripting.FileSystemObject") 
Set Folder = OBJ.GetFolder(strPath) 

Call ListFiles(Folder) 

Dim SubFolder As Object 

For Each SubFolder In Folder.SubFolders 
    Call ListFiles(SubFolder) 
    Call GetSubFolders(SubFolder) 
Next SubFolder 


End Sub 

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

Sub ListFiles(ByRef Folder As Object) 

On Error Resume Next 
For Each File In Folder.Files 
     ActiveCell.Offset(1, 0).Select 
     ActiveCell = File.Name 
     ActiveCell.Offset(0, 1).Select 
     ActiveCell.Offset(0, 1) = File.Path 
      ActiveCell.Offset(0, 0).Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 0), Address:=File.Path, TextToDisplay:=File.Path 
     ActiveCell.Offset(0, -1).Select 
     ActiveCell.Offset(0, 2) = (File.Size/1024) 'IN KB 
     ActiveCell.Offset(0, 3) = File.DateLastModified 
     ActiveCell.Offset(0, 4) = File.Attributes 
     ActiveCell.Offset(0, 5) = File.DateCreated 
     ActiveCell.Offset(0, 6) = File.DateLastAccessed 
     ActiveCell.Offset(0, 7) = File.Drive 
     ActiveCell.Offset(0, 8) = File.ParentFolder 
     ActiveCell.Offset(0, 9) = File.ShortName 
     ActiveCell.Offset(0, 10) = File.ShortPath 
     ActiveCell.Offset(0, 11) = File.Type 
Next File 

End Sub 

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

Sub GetSubFolders(ByRef SubFolder As Object) 

Dim FolderItem As Object 
On Error Resume Next 
For Each FolderItem In SubFolder.SubFolders 
    Call ListFiles(FolderItem) 
    Call GetSubFolders(FolderItem) 
Next FolderItem 

End Sub 


Function GetFolder() As String 
    Dim fldr As FileDialog 
    Dim sItem As String 
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 
    With fldr 
     .Title = "Select a Folder" 
     .AllowMultiSelect = False 
     .InitialFileName = Application.DefaultFilePath 
     If .Show <> -1 Then GoTo NextCode 
     sItem = .SelectedItems(1) 
    End With 
NextCode: 
    GetFolder = sItem 
    Set fldr = Nothing 
End Function 

Answer 2

這是一個完全不同的事情。如果你想通過電子郵件發送不同的文件對不同的人，建立一個Excel「模板」根據您的具體需求，並運行下面的腳本。

請在表（ 「工作表Sheet1」）的列表：人民 在B列的名稱：在A列

E-mail地址 在列C：Z：文件名類似這樣的C：\ Data \ Book2.xls（不一定是Excel文件）

宏將循環遍歷「Sheet1」中的每一行，並且如果B列中存在電子郵件地址 和文件名列C：Z它會創建一封包含此信息的郵件併發送。

Sub Send_Files() 
'Working in Excel 2000-2016 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim sh As Worksheet 
    Dim cell As Range 
    Dim FileCell As Range 
    Dim rng As Range 

    With Application 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Set sh = Sheets("Sheet1") 

    Set OutApp = CreateObject("Outlook.Application") 

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants) 

     'Enter the path/file names in the C:Z column in each row 
     Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1") 

     If cell.Value Like "?*@?*.?*" And _ 
      Application.WorksheetFunction.CountA(rng) > 0 Then 
      Set OutMail = OutApp.CreateItem(0) 

      With OutMail 
       .to = cell.Value 
       .Subject = "Testfile" 
       .Body = "Hi " & cell.Offset(0, -1).Value 

       For Each FileCell In rng.SpecialCells(xlCellTypeConstants) 
        If Trim(FileCell) <> "" Then 
         If Dir(FileCell.Value) <> "" Then 
          .Attachments.Add FileCell.Value 
         End If 
        End If 
       Next FileCell 

       .Send 'Or use .Display 
      End With 

      Set OutMail = Nothing 
     End If 
    Next cell 

    Set OutApp = Nothing 
    With Application 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 
End Sub 

https://www.rondebruin.nl/win/s1/outlook/amail6.htm

Answer 3

如果你想不同的文件通過電子郵件發送給不同的人，看到下面的腳本。

請在表（ 「工作表Sheet1」）的列表：

在列A：E-mail地址

在列C：Z中的人

在B列的名稱：喜歡這款C文件名：\ DATA \ Book2.xls中（不必是Excel文件）

通過「Sheet1中」每行宏將循環，如果在B列的E-mail地址 和列C中的文件名：Z它將創建一個包含此信息的郵件併發送它。

Sub Send_Files() 
'Working in Excel 2000-2016 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim sh As Worksheet 
    Dim cell As Range 
    Dim FileCell As Range 
    Dim rng As Range 

    With Application 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Set sh = Sheets("Sheet1") 

    Set OutApp = CreateObject("Outlook.Application") 

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants) 

     'Enter the path/file names in the C:Z column in each row 
     Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1") 

     If cell.Value Like "?*@?*.?*" And _ 
      Application.WorksheetFunction.CountA(rng) > 0 Then 
      Set OutMail = OutApp.CreateItem(0) 

      With OutMail 
       .to = cell.Value 
       .Subject = "Testfile" 
       .Body = "Hi " & cell.Offset(0, -1).Value 

       For Each FileCell In rng.SpecialCells(xlCellTypeConstants) 
        If Trim(FileCell) <> "" Then 
         If Dir(FileCell.Value) <> "" Then 
          .Attachments.Add FileCell.Value 
         End If 
        End If 
       Next FileCell 

       .Send 'Or use .Display 
      End With 

      Set OutMail = Nothing 
     End If 
    Next cell 

    Set OutApp = Nothing 
    With Application 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 
End Sub