none
Creating folders from query results RRS feed

  • Question

  • Hello I have some code that works which runs a query, exports the results to excel 64 bit from Office 365, then runs some VBA code in excel to create folders based on query data inserted into a range. I would like everything to run inside 64 bit Access from office 365 only without the need for Excel.

    The access code I am using is:

    Dim Foldername As String Foldername = (CurrentProject.Path & "\StudentSAISIDFolderCreate.xlsm") DoCmd.TransferSpreadsheet acExport, 8, "ExcelSAISIDList", Foldername, True, "SAISIDS" Dim xl As Object Set xl = CreateObject("Excel.Application") xl.Workbooks.Open Foldername xl.Visible = False xl.Run "MakeFolders" xl.ActiveWorkbook.Close (True) xl.Quit Set xl = Nothing On Error Resume Next End Sub

    The code I have in Excel is:

    Sub MakeFolders()
    Dim Rng As Range
    Dim maxRows, maxCols, r, c As Integer
    Set Rng = Range("B2:B60")
    maxRows = Rng.Rows.Count
    maxCols = Rng.Columns.Count
    For c = 1 To maxCols
    r = 1
    Do While r <= maxRows
    If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
    MkDir (ActiveWorkbook.Path & "\StudentFolders\" & Rng(r, c))
    On Error Resume Next
    End If
    r = r + 1
    Loop
    Next c
    End Sub

    If anyone can help I would really appreciate it.


    • Edited by _Sniffles_ Tuesday, May 29, 2018 2:40 AM Forgot to include office version info
    Tuesday, May 29, 2018 2:24 AM

Answers

  • Hi,

    should be sth. like this (Caution! Air code):

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim f As Field

    Set db = CurrentDb
    Set rs = db.OpenRecordset("ExcelSAISIDList", dbOpenSnapshot)

    Do Until rs.EOF
        For Each f In rs.Fields
            If Len(Dir(CurrentProject.Path & "\" & f, vbDirectory)) = 0 Then
                MkDir CurrentProject.Path & "\StudentFolders\" & f
            End If       
        Next f
        rs.MoveNext
    Loop

    The code needs a reference to the DAO library, i.e. Microsoft Office 16.0 Access Database Engine Object Library

    And of course you should add some error and garbage handling, not only Resume Next. ;-)


    Karl
    http://www.AccessDevCon.com
    http://www.donkarl.com

    Tuesday, May 29, 2018 12:48 PM

All replies

  • Hi,

    should be sth. like this (Caution! Air code):

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim f As Field

    Set db = CurrentDb
    Set rs = db.OpenRecordset("ExcelSAISIDList", dbOpenSnapshot)

    Do Until rs.EOF
        For Each f In rs.Fields
            If Len(Dir(CurrentProject.Path & "\" & f, vbDirectory)) = 0 Then
                MkDir CurrentProject.Path & "\StudentFolders\" & f
            End If       
        Next f
        rs.MoveNext
    Loop

    The code needs a reference to the DAO library, i.e. Microsoft Office 16.0 Access Database Engine Object Library

    And of course you should add some error and garbage handling, not only Resume Next. ;-)


    Karl
    http://www.AccessDevCon.com
    http://www.donkarl.com

    Tuesday, May 29, 2018 12:48 PM
  • Oops, I didn't notice:

    Set Rng = Range("B2:B60")

    If it means that you only want the first 59 values of column B then try:

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Long

    Set db = CurrentDb
    Set rs = db.OpenRecordset("ExcelSAISIDList", dbOpenDynaset)

    Do Until rs.EOF
        If Len(Dir(CurrentProject.Path & "\" & rs.Fields(1), vbDirectory)) = 0 Then
            MkDir CurrentProject.Path & "\StudentFolders\" & rs.Fields(1)
        End If
        i = i + 1
        If i = 59 Then Exit Do
        rs.MoveNext
    Loop


    Karl
    http://www.AccessDevCon.com
    http://www.donkarl.com

    Tuesday, May 29, 2018 1:12 PM
  • Wow thank you so much! This helps me tremendously. Works perfectly.

    I knew it was something simple, I just couldn't figure it out. Yeah I put the code together from a lot of different places. One place just had resume, so I thought if the folders already existed, maybe it would just keep going instead of stopping and producing an error message and create ones that didn't already exist. Doesn't work that way though in the code I supplied. Thank you so much for your time and your help. I really appreciate it a lot. This is actually better than limiting the amount with the code below, the code I had originally was based on whatever range was selected but since I didn't know how to loop it, I just set an amount larger than what I needed but excluding the result header. Having that code below though helps me out a lot too.  Thanks so much.


    • Edited by _Sniffles_ Tuesday, May 29, 2018 1:34 PM
    Tuesday, May 29, 2018 1:33 PM