找到，如果工作簿個別用戶存在，如果工作簿不存在，創建模板

一個新的工作簿我有我試圖讓每個人對我的工作組的數據文件。數據文件需要與主文件相同，因爲每個人數據將被收集到所述主文件以及單個數據文件中。找到，如果工作簿個別用戶存在，如果工作簿不存在，創建模板

到目前爲止，我有以下的代碼，我試圖找出用戶是否已經有一個工作簿。我希望創建的工作簿與主工作簿具有相同的前四張。

指定的文件夾只包含了「數據文件大師」工作簿，所以我不希望宏時間比約5秒鐘。但是，當我嘗試運行宏時，工作簿變得無法響應。

該計劃不會導致一個錯誤報告或預示着什麼調試。

有沒有人有任何想法？

Sub StoreToPersonal() 
    Application.ScreenUpdating = False 
    ckIndWkbk = False 
    folderpath = "\\netappa\Path\MACRO UPDATE WORKBOOKS" 'change to suit 

    If Right(folderpath, 1) <> "\" Then folderpath = folderpath + "\" 

    filename = Dir(folderpath & "*.xlsm") 
    'Look through path length and find if user has an individual Workbook with a Boolean Statement 

    Do While filename <> "" 
     If InStr(filename, Environ("Username")) Then 
     ckIndWkbk = True 
     Else 
    End If 

    Loop 

     If ckIndWkbk = False Then 
      Set wb = Workbooks.Open("\\netappa\Path\MACRO UPDATE WORKBOOKS\DataFile Master.xlsm") 
       ws = wb.Sheets.Count 
        For Each ws In wb 
         If ws.Index > 4 Then 
          Application.DisplayAlerts = False 
           ws.Delete 
          Application.DisplayAlerts = True 
         End If 
        Next ws 

      wb.SaveAs ("\\netappa\Path\MACRO UPDATE WORKBOOKS\\DataFile For " & Environ("Username")) 

     End If 

Application.ScreenUpdating = True 

End Sub

來源

2017-08-09 OrangeHippo

你只知道前手的文件名，那麼你爲什麼需要循環？檢查特定用戶文件本身。另外，在保存期間，您缺少文件擴展名。 – cyboashu

我該如何去檢查特定的用戶文件？並感謝您指出文件擴展名！ – OrangeHippo

沒關係，我想出了你的建議！謝謝！ – OrangeHippo

第一Dir調用設置的參數，並在目錄返回的第一個文件。您需要使用Dir在Do Loop返回後續文件。

注：我添加Exit Do的條件得到滿足後。

MSDN Dir Function

Sub StoreToPersonal() 
    Application.ScreenUpdating = False 
    ckIndWkbk = False 
    folderpath = "\\netappa\Path\MACRO UPDATE WORKBOOKS" 'change to suit 

    If Right(folderpath, 1) <> "\" Then folderpath = folderpath + "\" 

    Filename = Dir(folderpath & "*.xlsm") 
    'Look through path length and find if user has an individual Workbook with a Boolean Statement 

    Do While Filename <> "" 
     If InStr(Filename, Environ("Username")) Then 
      ckIndWkbk = True 
      Exit Do 
     End If 
     Filename = Dir 
    Loop 

    If ckIndWkbk = False Then 
     Set wb = Workbooks.Open("\\netappa\Path\MACRO UPDATE WORKBOOKS\DataFile Master.xlsm") 
     ws = wb.Sheets.Count 
     For Each ws In wb 
      If ws.Index > 4 Then 
       Application.DisplayAlerts = False 
       ws.Delete 
       Application.DisplayAlerts = True 
      End If 
     Next ws 

     wb.SaveAs ("\\netappa\Path\MACRO UPDATE WORKBOOKS\\DataFile For " & Environ("Username")) 

    End If 

    Application.ScreenUpdating = True 

End Sub

來源

2017-08-09 16:43:21

找到，如果工作簿個別用戶存在，如果工作簿不存在，創建模板

回答

相關問題