Posts by homegrownandy

homegrownandy · Apr 6th 2016

Re: Copy associated cells for not blank cells.

Ive done as sugested, Just hope someone can help me do this as doing this manually would take so long.

Cheers..

homegrownandy · Apr 5th 2016

I have a spreadsheet with date values in row 1 and in column A i have a list of jobs. We have thousands of entrys on this spreadsheet, which shows work we carried out and when.

In every cell with a value (not blank) I would like for that to be pasted on a new sheet, with the accociated date (row one) and associated job name (column A) to be pasted in the cells next to it.

It would take me weeks to go through all of this data manually, with each one checking dates and names. So if i have this in a table with the name/date/note all in a list format I can upload them to the database.

The dates are all now text values, so copying them isnt an issue.

Hope someone can help me put together some code.

forum.ozgrid.com/index.php?attachment/68775/
Edit: This is some sample data just showing what exists and what I want. I would like the new data to be on a new sheet, and in this example the data is far less than whats on the actual data.

thanks

homegrownandy · Apr 4th 2016

Re: Method or data member not found

The one for the survey does work though and this is also in excel (the majority of the time). Can you sugest a solution or how I might change this? Thanks.

homegrownandy · Apr 4th 2016

Re: Method or data member not found

Thanks for the replies, hope you had a good weekend.

Firstly I paid someone a few months ago to make this code, and it runs fine in excel. I cant get hold of the guy now. I do have some limited VBA knowlege but you can probably assume I have none.

I didnt want to fill up the thread with code that wasnt causing the error but it may help if you see everything.

This is from the excel document. (without the search functionality for site name)

Code

Option Explicit
' This is giving us access to the Windows Shell which we'll use to print
'  documents that aren't Word or Excel
Public Const SW_SHOWNORMAL As Long = 1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
Const FOLDER_TO_SEARCH = "[URL="file://\\SERVER\general\Installation\!SITES\BATCH"]\\SERVER\general\Installation\!SITES\BATCH[/URL] 4c\whaves_nw"
Const KEYWORD_SURVEY = "survey"
Const KEYWORD_RAMS = "rams"
Const KEYWORD_TESTPLAN = "test"
Const CONFIRMATION_PROMPT = False


Sub GetFilesToPrint()
    Dim obj As Object
    Dim MySource As Object
    Dim file As Variant
    Dim filesFound As Long
    Dim cleanFolder As String
    Dim boolPrintMe As Boolean
    
    ' If there's not a trailing backslash add one
    If Right(FOLDER_TO_SEARCH, 1) <> "" Then
        cleanFolder = FOLDER_TO_SEARCH & ""
    Else
        cleanFolder = FOLDER_TO_SEARCH
    End If
    
    ' Start with the first file
    
    file = Dir(cleanFolder)
    
    ' While the file list is not blank...
    While (file <> "")
        ' By default we want to print
        boolPrintMe = True
        
        ' If we find the keyword for a survey in there print the survey
        If InStr(UCase(file), UCase(KEYWORD_SURVEY)) > 0 Then
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a survey:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
                ' Increment a coun
                filesFound = filesFound + 1
                
                ' Print the file
                If boolPrintMe Then
                ' If we have anextention of .xls? then it's an Excel file and we need to
                '  note it
                If InStr(UCase(file), UCase(".xls")) > 0 Then
                    Print_Survey CStr(cleanFolder & file), True
                Else
                    Print_Survey CStr(cleanFolder & file), False
                End If
            End If
        End If
            
            
        ' If we find the keyword for a RAMS document in there print the RAMS
        If InStr(UCase(file), UCase(KEYWORD_RAMS)) > 0 Then
            
            ' Increment a counter
            filesFound = filesFound + 1
            
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a RAMS document:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
            
            ' Print the file
            If boolPrintMe Then Print_RAMS (cleanFolder & file)
        End If
        
        ' If we find the keyword for a test plan in there print the test plan
        If InStr(UCase(file), UCase(KEYWORD_TESTPLAN)) > 0 Then
            ' Increment a counter
            filesFound = filesFound + 1
            
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a test plan:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
            
            ' Print the file
            If boolPrintMe Then Print_TestPlan (cleanFolder & file)
        End If
        
     file = Dir
  Wend
  
  MsgBox "Files found: " & filesFound
End Sub
 


Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
'  then prints selected worksheets.                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Turn of alerts momentarily so something doesn't freak out
    Application.DisplayAlerts = True
    
    ' Open the workbook
    Set wb = Application.Workbooks.Open(strTestPlanName)
    
    ' Print the first worksheet
    ' this is fucked Set ws = wb.Worksheets(1)
    ' this too ws.PrintOut
    
    ' Print the second worksheet
    Set ws = wb.Worksheets(3)
    With ws.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
    End With
    ws.PrintOut
    
    ' Close the document; don't save
    wb.Close SaveChanges:=False
    
    ' Turn alerts back on
    Application.DisplayAlerts = False
    
    ' Clean up
    Set wb = Nothing
    Set ws = Nothing
End Function


Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's   '
'  an Excel file.  If it is an Excel file it goes through and prints a set  '
'  of selected pages; if not it just prints the whole document.             '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' If it's an Excel file we treat it differently
    If boolIsExcelFile = True Then
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lngOrientation As Long
        Dim lngPaperSize As Long
        Dim boolPrintMe As Boolean
        
        ' Open the Survey workbook
        Set wb = Workbooks.Open(strSurveyName)
        
        ' Parse through each worksheet
        For Each ws In wb.Worksheets
            
            ' By default we want to print
            boolPrintMe = True
        
            ' Look at the worksheet name; if it's one of the ones we want to print
            '  then set the orientation and paper size; otherwise do nothing
            Select Case ws.Name
                Case Is = "Title Sht "
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 1"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 2"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 3"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 4"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 5"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "UU Provided information"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "SES CDC"
                    lngOrientation = xlLandscape
                    lngPaperSize = xlPaperA4
            
                Case Else
                    ' If it's not one of the above then don't print
                    boolPrintMe = False
            
            End Select
            
            ' If we want to print we just need to set the info
            If boolPrintMe = True Then
                ' Set the orientation and paper size
                With ws.PageSetup
                    .Orientation = lngOrientation
                    .PaperSize = lngPaperSize
                End With
                
                ' Print it
                ws.PrintOut
            End If
        
        ' Go to the next worksheet
        Next ws
            
        ' Close the survey but don't save it
        wb.Close SaveChanges:=False
    Else
        ' If it's anything else except an Excel document, we just print
        ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
    End If
End Function
 
Function Print_RAMS(strRAMSName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file and then prints it.         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Call the Shell to execute the file
    ShellExecute 0, "print", strRAMSName, vbNullString, "", SW_SHOWNORMAL
End Function
    
    
Function OLD_FUNCTION()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file, opens an instance of Word, '
'  changes the font color in the document and then prints it.  Afterwards   '
'  it closes the document (without saving).                                 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim wd As Object
    Dim doc As Object
    Dim rng As Object
    
    ' Create instances of our Word Application and Document class
    Set wd = CreateObject("Word.Application")
    Set doc = CreateObject("Word.Document")
    
    ' Make Word visible, but turn off alerts
    wd.Visible = True
    wd.DisplayAlerts = wdAlertsNone
    
    ' Open the RAMS doc
    Set doc = wd.Documents.Open(strRAMSName)
    
    ' Select the range, then turn all the fonts to black
    Set rng = wd.ActiveDocument.Range
    rng.wholestory
    rng.Font.ColorIndex = wdBlack
    
    ' Print the document
    doc.PrintOut
    
    ' Close the RAMS doc; don't save changes
    doc.Close SaveChanges:=False
    
    ' Turn alerts back on and quit Word
    wd.DisplayAlerts = wdAlertsAll
    wd.Quit SaveChanges:=False
End Function

Display More

In access, I'm using debug print to check the value of the folder its searching and thats working. (this took me a few hours in itself) This is whats assigned to the button click.

Code

ption Compare Database
Private Sub AddAppt_Click()
On Error GoTo AddAppt_Err
         ' Save record first to be sure required fields are filled.
         DoCmd.RunCommand acCmdSaveRecord
         ' Exit the procedure if appointment has been added to Outlook.
         If Me!AddedToOutLook = True Then
            MsgBox "This appointment already added to Microsoft Outlook"
            Exit Sub
         ' Add a new appointment.
         Else
            Dim outobj As Outlook.Application
            Dim outappt As Outlook.AppointmentItem
            Set outobj = CreateObject("outlook.application")
            Set outappt = outobj.CreateItem(olAppointmentItem)
            With outappt
               .Start = Me!ApptDate & " " & Me!ApptTime
               .Duration = Me!ApptLength
               .Subject = Me!Appt
               .Categories = "red;"
                   .AllDayEvent = True
               If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
               If Not IsNull(Me!ApptLocation) Then .Location = _
                  Me!ApptLocation
               If Me!ApptReminder Then
                  .ReminderMinutesBeforeStart = Me!ReminderMinutes
                  .ReminderSet = True
                 
               End If
               .Save
            End With
         End If
         ' Release the Outlook object variable.
         Set outobj = Nothing
         ' Set the AddedToOutlook flag, save the record, display a message.
         Me!AddedToOutLook = True
         
        DoCmd.SetWarnings False
         DoCmd.RunCommand acCmdSaveRecord
         DoCmd.OpenQuery "incriment visit"
          DoCmd.SetWarnings True
         
         MsgBox "Appointment Added!"
      Exit Sub
AddAppt_Err:
         MsgBox "Error " & Err.Number & vbCrLf & Err.Description
         Exit Sub
End Sub
Private Sub Command46_Click()
Const FOLDER_TO_SEARCH = "[URL="file://\\SERVER\general\Installation\!ALL"]\\SERVER\general\Installation\!ALL[/URL] SITES"
Const KEYWORD_SURVEY = "survey"
Const KEYWORD_RAMS = "rams"
Const KEYWORD_TESTPLAN = "test"
Const CONFIRMATION_PROMPT = False
 
    Dim SITE As Variant
    Dim obj As Object
    Dim MySource As Object
    Dim file As Variant
    Dim filesFound As Long
    Dim cleanFolder As String
    Dim boolPrintMe As Boolean
    
    
    file = FOLDER_TO_SEARCH & Forms("frmAppointments NEW JOBS").Site_Name & ""
    
    If file = False Then
        Debug.Print "No SITE name selected."
    Else
        Debug.Print "One SITE selected: " & file
    End If
    
    
    ' If there's not a trailing backslash add one
   ' If Right(FOLDER_TO_SEARCH, 1) <> "" Then
    '    cleanFolder = FOLDER_TO_SEARCH & ""
  '  Else
        cleanFolder = file
   ' End If
    
    ' Start with the first file
    
    file = Dir(cleanFolder)
    
    ' While the file list is not blank...
    While (file <> "")
        ' By default we want to print
        boolPrintMe = True
        
        ' If we find the keyword for a survey in there print the survey
        If InStr(UCase(file), UCase(KEYWORD_SURVEY)) > 0 Then
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a survey:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
                ' Increment a coun
                filesFound = filesFound + 1
                
                ' Print the file
                If boolPrintMe Then
                ' If we have anextention of .xls? then it's an Excel file and we need to
                '  note it
                If InStr(UCase(file), UCase(".xls")) > 0 Then
                    Print_Survey CStr(cleanFolder & file), True
                Else
                    Print_Survey CStr(cleanFolder & file), False
                End If
            End If
        End If
            
            
        ' If we find the keyword for a RAMS document in there print the RAMS
        If InStr(UCase(file), UCase(KEYWORD_RAMS)) > 0 Then
            
            ' Increment a counter
            filesFound = filesFound + 1
            
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a RAMS document:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
            
            ' Print the file
            If boolPrintMe Then Print_RAMS (cleanFolder & file)
        End If
        
        ' If we find the keyword for a test plan in there print the test plan
        If InStr(UCase(file), UCase(KEYWORD_TESTPLAN)) > 0 Then
            ' Increment a counter
            filesFound = filesFound + 1
            
            ' If we're using a confirmation prompt then let's prompt
            If CONFIRMATION_PROMPT = True Then If MsgBox("Found a test plan:  " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
            
            ' Print the file
            If boolPrintMe Then Print_TestPlan (cleanFolder & file)
        End If
        
     file = Dir
  Wend
  
  MsgBox "Files found: " & filesFound
End Sub
 


Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
'  then prints selected worksheets.                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Turn of alerts momentarily so something doesn't freak out
    Application.DisplayAlerts = True
    
    ' Open the workbook
    Set wb = Application.Workbooks.Open(strTestPlanName)
    
    ' Print the first worksheet
    
    Set ws = wb.Worksheets(1)
    '
    ws.PrintOut
    
    ' Print the second worksheet
    Set ws = wb.Worksheets(3)
    With ws.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
    End With
    ws.PrintOut
    
    ' Close the document; don't save
    wb.Close SaveChanges:=False
    
    ' Turn alerts back on
    Application.DisplayAlerts = False
    
    ' Clean up
    Set wb = Nothing
    Set ws = Nothing
End Function


Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's   '
'  an Excel file.  If it is an Excel file it goes through and prints a set  '
'  of selected pages; if not it just prints the whole document.             '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' If it's an Excel file we treat it differently
    If boolIsExcelFile = True Then
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lngOrientation As Long
        Dim lngPaperSize As Long
        Dim boolPrintMe As Boolean
        
        ' Open the Survey workbook
        Set wb = Workbooks.Open(strSurveyName)
        
        ' Parse through each worksheet
        For Each ws In wb.Worksheets
            
            ' By default we want to print
            boolPrintMe = True
        
            ' Look at the worksheet name; if it's one of the ones we want to print
            '  then set the orientation and paper size; otherwise do nothing
            Select Case ws.Name
                Case Is = "Title Sht "
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 1"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 2"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 3"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 4"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 5"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "UU Provided information"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "SES CDC"
                    lngOrientation = xlLandscape
                    lngPaperSize = xlPaperA4
            
                Case Else
                    ' If it's not one of the above then don't print
                    boolPrintMe = False
            
            End Select
            
            ' If we want to print we just need to set the info
            If boolPrintMe = True Then
                ' Set the orientation and paper size
                With ws.PageSetup
                    .Orientation = lngOrientation
                    .PaperSize = lngPaperSize
                End With
                
                ' Print it
                ws.PrintOut
            End If
        
        ' Go to the next worksheet
        Next ws
            
        ' Close the survey but don't save it
        wb.Close SaveChanges:=False
    Else
        ' If it's anything else except an Excel document, we just print
        ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
    End If
End Function
 
Function Print_RAMS(strRAMSName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file and then prints it.         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Call the Shell to execute the file
    ShellExecute 0, "print", strRAMSName, vbNullString, "", SW_SHOWNORMAL
End Function
    
    
Function OLD_FUNCTION()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file, opens an instance of Word, '
'  changes the font color in the document and then prints it.  Afterwards   '
'  it closes the document (without saving).                                 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim wd As Object
    Dim doc As Object
    Dim rng As Object
    
    ' Create instances of our Word Application and Document class
    Set wd = CreateObject("Word.Application")
    Set doc = CreateObject("Word.Document")
    
    ' Make Word visible, but turn off alerts
    wd.Visible = True
    wd.DisplayAlerts = wdAlertsNone
    
    ' Open the RAMS doc
    Set doc = wd.Documents.Open(strRAMSName)
    
    ' Select the range, then turn all the fonts to black
    Set rng = wd.ActiveDocument.Range
    rng.wholestory
    rng.Font.ColorIndex = wdBlack
    
    ' Print the document
    doc.PrintOut
    
    ' Close the RAMS doc; don't save changes
    doc.Close SaveChanges:=False
    
    ' Turn alerts back on and quit Word
    wd.DisplayAlerts = wdAlertsAll
    wd.Quit SaveChanges:=False
    DoCmd.OpenQuery "incriment printed"
End Function

Display More

Then this is module2 on the database:

Code

Option Compare Database
Public Const SW_SHOWNORMAL As Long = 1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long

Pike: I'm not 100% how this works but im assuming that value is uupdated when the keyword test is found in that folder.

Batman:
1. If thats not declared in the code shown here then no. I wish I could know the answer to the question you ask.
2. I thought exactally the same, but when it wasnt breaking I just left it like that.
3. I'm happy to use subs or any method if it works. This is what was supplied to me.

Note: Even leaving the code exactaly the same (without the folder search.. but with module2) the error remains in access.

homegrownandy · Apr 1st 2016

Re: Method or data member not found

Anyone have any suggestions?

homegrownandy · Mar 31st 2016

Compile error: Method or data member not found.

Code

Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
'  then prints selected worksheets.                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Turn of alerts momentarily so something doesn't freak out
    Application.DisplayAlerts = True
    
    ' Open the workbook
    Set wb = Application.Workbooks.Open(strTestPlanName)
    
    ' Print the first worksheet
    ' this is fucked
    Set ws = wb.Worksheets(1)
    ' this too
    ws.PrintOut
    
    ' Print the second worksheet
    Set ws = wb.Worksheets(3)
    With ws.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
    End With
    ws.PrintOut
    
    ' Close the document; don't save
    wb.Close SaveChanges:=False
    
    ' Turn alerts back on
    Application.DisplayAlerts = False
    
    ' Clean up
    Set wb = Nothing
    Set ws = Nothing
End Function


Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's   '
'  an Excel file.  If it is an Excel file it goes through and prints a set  '
'  of selected pages; if not it just prints the whole document.             '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' If it's an Excel file we treat it differently
    If boolIsExcelFile = True Then
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lngOrientation As Long
        Dim lngPaperSize As Long
        Dim boolPrintMe As Boolean
        
        ' Open the Survey workbook
        Set wb = Workbooks.Open(strSurveyName)
        
        ' Parse through each worksheet
        For Each ws In wb.Worksheets
            
            ' By default we want to print
            boolPrintMe = True
        
            ' Look at the worksheet name; if it's one of the ones we want to print
            '  then set the orientation and paper size; otherwise do nothing
            Select Case ws.Name
                Case Is = "Title Sht "
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 1"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 2"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 3"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 4"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Audit 5"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "Provided information"
                    lngOrientation = xlPortrait
                    lngPaperSize = xlPaperA4
            
                Case Is = "SES CDC"
                    lngOrientation = xlLandscape
                    lngPaperSize = xlPaperA4
            
                Case Else
                    ' If it's not one of the above then don't print
                    boolPrintMe = False
            
            End Select
            
            ' If we want to print we just need to set the info
            If boolPrintMe = True Then
                ' Set the orientation and paper size
                With ws.PageSetup
                    .Orientation = lngOrientation
                    .PaperSize = lngPaperSize
                End With
                
                ' Print it
                ws.PrintOut
            End If
        
        ' Go to the next worksheet
        Next ws
            
        ' Close the survey but don't save it
        wb.Close SaveChanges:=False
    Else
        ' If it's anything else except an Excel document, we just print
        ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
    End If
End Function

Display More

Function Print_TestPlan(strTestPlanName As String) --- this is highlighted yellow

Application.DisplayAlerts = True --- this is highlighted blue

Ive messed about referencing the DAO object library instead of the access one. Nothing seems to resolve the issue.

The code I have shown does work for the survey but not the testplan. I have no idea what i can do to fix this now as I've looked at everything I can think of/have come accross searching the internet.

Could someone help me here?

This code does work "as is" when run through excel.

Thanks in advance

Andy

homegrownandy · Feb 19th 2016

Re: Using multiple variables in VBA

Thanks for that. I know its easy, I can see now lol. This has helped me understand a bit more.

homegrownandy · Feb 19th 2016

Re: Using multiple variables in VBA

I was concerned about the formatting. I didnt actually do this code Im a bit clueless, but ill have a play and post an update on monday. This is what i want to achieve but usually I just break code.

Code

.Body = "Hardwired signals: " & ws.cells(lngRow, "I") Notes: & ws.cells(lngRow, "j")

homegrownandy · Feb 19th 2016

I have some code that imports calendar events to outlook.

I would like to include within the body text a variable or possibly multiple variables depending what information we recieve.

Heres the code:

Code

Private Sub CreateAppointment(ws As Excel.Worksheet, lngRow As Long)
   Dim oAppt            As Object                     'Outlook.AppointmentItem
   Dim blnCreated       As Boolean
   Dim oFolder          As Object                     'Outlook.MAPIFolder
   Dim lngAddRow        As Long
   Const olMeeting = 1
   'On Error Resume Next
   Set oFolder = oNS.GetDefaultFolder(&H9)            ' olFolderCalendar
   Set oAppt = oFolder.Items.Add(&H1)                 '   olAppointmentItem
   Application.StatusBar = "Adding " & ws.Cells(lngRow, 1).Value
   With oAppt
      'Define calendar item properties
      .Start = ws.Cells(lngRow, 7).Value + ws.Cells(lngRow, 8).Value
      '.End = ws.Cells(lngRow, 7).Value + TimeValue("01:00:00")
      .Subject = ws.Cells(lngRow, 1).Value
      .Location = ws.Cells(lngRow, 6).Value
      .AllDayEvent = True
      .Body = "Hardwired signals: "
      .BusyStatus = False
      '.ReminderMinutesBeforeStart = ws.Cells(lngRow, 7).Value - TimeValue("00:30:00")
      .ReminderSet = False
      .Categories = shtImport.Range("CategoryName").Value
     .MeetingStatus = olMeeting
      .RequiredAttendees = "[EMAIL="test@test/"]test@test[/EMAIL].com"
        .Send
      .Save
   End With
   Set oAppt = Nothing
   Set oFolder = Nothing
   Exit Sub
ErrHandler:
   'MsgBox "An error occurred - Exporting items to Calendar."

Display More

i want to change this:

Code

.Body = "Hardwired signals: "

I want to keep the .Body = "Hardwired signals: " but then also include information from cells next to it. (column I and J for example.)

I hope someone can help. Thanks.

homegrownandy · Feb 11th 2016

Re: vba to send email

Bit of a long shot here but maybe you know. When it sends this way it comes on my calendar as accepted. but on the shared calendar its no response. If i click the send button myself it works on both.

homegrownandy · Feb 11th 2016

Re: vba to send email

Thanks for the reply.

Code

Sub AutoAcceptMeetings(oRequest As MeetingItem)
 
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
  Exit Sub
End If
 
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
 
Dim oResponse
 Set oResponse = oAppt.Respond(olMeetingAccepted, True)
 oResponse.display
oResponse.Send
End Sub

Display More

Apparently it does need to open first then send. Thanks for the help though

homegrownandy · Feb 11th 2016

http://www.slipstick.com/outlo…ting-request-using-rules/

Im using the code here. Or specifically im using:

Code

Sub AutoAcceptMeetings(oRequest As MeetingItem)
 
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
  Exit Sub
End If
 
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
 
Dim oResponse
 Set oResponse = oAppt.Respond(olMeetingAccepted, True)
 oResponse.Display
End Sub

Display More

Thats all well and good. But how do I send the response? haha

homegrownandy · Feb 11th 2016

Re: VBA report generator

Anyone had a chance to look at this or have any questions?

homegrownandy · Feb 10th 2016

forum.ozgrid.com/index.php?attachment/68251/

Hello,

I have a document we use for generating estimates for the customer, I want to automate some of the copy/pasting and the PDF creation.

As you can see in the attachment. The way this all works is fine, but im open to suggestions to improve it. The thing I need help with is the summery page. Where it says line 1, and line 1 cost breakdown, I want that information to be populated when a button is pushed.

*A "line" on the summery page represents a sheet in the document. 1/2/3 are examples of the sheets but they could be named anything.
* Information to be copied over is anything selected in the table, from columns B,C,D and J (these have the same title as the summery page.)
* Too add to confusion; there are two sections to the table. We have parts and Labour, all of these need to be copied over if there is a selection in that row. Using "Qty" column D could be a good check. Anything in this column with a value is what we want moved.
* I've just thought of this now, but moving cost index to sheet 2 could help (so it looks at sheet 3 onwards and this page doesn’t need to be excluded).
*where we have on the summery page "Line 1 Cost Breakdown" this can say "sheet name Cost Breakdown" (whatever that sheet name may be.
*We are not limited to three sheets, there may be a lot more. Once line one information is added i would like for it to add line 2 and so on.

I hope I've explained that clearly enough to get some advice. Or even better If someone has the time to put something together for me. I would be very greatful.

Thank you. Andy,

homegrownandy · Jan 29th 2016