I want to copy files to a shared OneDrive folder using VBA code

[uc bucuk]

I am able to create a folder in a shared OneDrive folder using VBA code assigned to a button. However, if any of the shared individuals try to create a folder using the same button, the VBA code throws an error

Sub CikanA1()
    Dim kaynakPath As String
    Dim hedefPath As String
    Dim yeniKlasorAdi As String
    
   
    If Range("C2").Interior.Color = RGB(255, 255, 0) Then
     
        kaynakPath = "C:\Users\ucbucuk\OneDrive - Astic\Masaüstü\Alp_QR\A1"
        
     
        hedefPath = "C:\Users\ucbucuk\OneDrive - Astic\Masaüstü\Alp_QR\___ÇIKAN İMALATLAR\"
        
        
        yeniKlasorAdi = Format(Date, "yyyy-mm-dd") & "-A1"
        
      
        On Error Resume Next
        MkDir hedefPath & yeniKlasorAdi
        On Error GoTo 0
        
      
        If Dir(hedefPath & yeniKlasorAdi, vbDirectory) <> "" Then
         
            Dim dosyaAdi As String
            dosyaAdi = Dir(kaynakPath & "\*.*", vbDirectory)
            
            Do While dosyaAdi <> ""
                If dosyaAdi <> "." And dosyaAdi <> ".." Then
                    FileCopy kaynakPath & "\" & dosyaAdi, hedefPath & yeniKlasorAdi & "\" & dosyaAdi
                End If
                dosyaAdi = Dir
            Loop
            
            MsgBox "Dosya kopyalandı.", vbInformation
        Else
            MsgBox "Hedef klasör oluşturulamadı.", vbCritical
        End If
    End If
End Sub

 

[John_w]

Try this, using FileSystemObject instead of native VBA file functions.

Sub CikanA1()
    Dim kaynakPath As String
    Dim hedefPath As String
    Dim yeniKlasorAdi As String
    Dim FSO As Object 'Scripting.FileSystemObject
    Dim FSfile As Object 'Scripting.File
    
    Set FSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject
    
    If Range("C2").Interior.Color = RGB(255, 255, 0) Then
     
        kaynakPath = "C:\Users\ucbucuk\OneDrive - Astic\Masaüstü\Alp_QR\A1"
     
        hedefPath = "C:\Users\ucbucuk\OneDrive - Astic\Masaüstü\Alp_QR\___ÇIKAN IMALATLAR\"
        
        yeniKlasorAdi = Format(Date, "yyyy-mm-dd") & "-A1"
      
        If Not FSO.FolderExists(hedefPath & yeniKlasorAdi) Then FSO.CreateFolder hedefPath & yeniKlasorAdi
        
        For Each FSfile In FSO.GetFolder(kaynakPath).Files
            FSfile.Copy hedefPath & yeniKlasorAdi & "\" & FSfile.Name
        Next
        MsgBox "Dosya kopyalandi.", vbInformation
    
    End If
End Sub

 

[uc bucuk]

It isn't happening. I think it's a onedrive related issue.